Set up packages, function sourcing, and plotting parameters

sapply(c(
         "rjson", 
         "data.table", 
         "dplyr", 
         "ggplot2", 
         "stringr", 
         "purrr", 
         "foreach", 
         "patchwork", 
         "testit",
         "lme4", 
         "lmerTest", 
         "latex2exp",
         "brms"#,
         #"tidybayes" # Patchwork/tidybayes ggplot dependency conflict, so source tidybayes directly  
         ), 
       require, character=TRUE)
## Loading required package: rjson
## Loading required package: data.table
## Loading required package: dplyr
## 
## Attaching package: 'dplyr'
## The following objects are masked from 'package:data.table':
## 
##     between, first, last
## The following objects are masked from 'package:stats':
## 
##     filter, lag
## The following objects are masked from 'package:base':
## 
##     intersect, setdiff, setequal, union
## Loading required package: ggplot2
## Loading required package: stringr
## Loading required package: purrr
## 
## Attaching package: 'purrr'
## The following object is masked from 'package:data.table':
## 
##     transpose
## Loading required package: foreach
## 
## Attaching package: 'foreach'
## The following objects are masked from 'package:purrr':
## 
##     accumulate, when
## Loading required package: patchwork
## Loading required package: testit
## Loading required package: lme4
## Loading required package: Matrix
## Loading required package: lmerTest
## 
## Attaching package: 'lmerTest'
## The following object is masked from 'package:lme4':
## 
##     lmer
## The following object is masked from 'package:stats':
## 
##     step
## Loading required package: latex2exp
## Loading required package: brms
## Loading required package: Rcpp
## Loading 'brms' package (version 2.21.0). Useful instructions
## can be found by typing help('brms'). A more detailed introduction
## to the package is available through vignette('brms_overview').
## 
## Attaching package: 'brms'
## The following object is masked from 'package:lme4':
## 
##     ngrps
## The following object is masked from 'package:stats':
## 
##     ar
##      rjson data.table      dplyr    ggplot2    stringr      purrr    foreach 
##       TRUE       TRUE       TRUE       TRUE       TRUE       TRUE       TRUE 
##  patchwork     testit       lme4   lmerTest  latex2exp       brms 
##       TRUE       TRUE       TRUE       TRUE       TRUE       TRUE
sf <- function() invisible(sapply(paste0("./Functions/", list.files("./Functions/", recursive=TRUE)), source)) # Source all fxs
sf()
DefPlotPars()

Behavioral data

packageVersion("brms")
## [1] '2.21.0'
packageVersion("rstanarm")
## [1] '2.32.1'

Note: These and other code paths need to be adjusted / dir structure needs to be reconstructed for public data. The public data also excludes demographics and, due to file size, simulations (simulations can be rerun using s.R)

Read in learn and test df

learn_df <- read.csv("../data/learn_df.csv")
test_df <- read.csv("../data/test_df.csv")
demogs <- read.csv("../data/demogs_deident.csv")

Demographics

summary(demogs$Age)
##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
##   19.00   30.00   37.00   38.42   47.00   65.00
mean(demogs$Age); sd(demogs$Age)
## [1] 38.42029
## [1] 11.42298
table(demogs$Sex)
## 
##      DATA_EXPIRED            Female              Male Prefer not to say 
##                 1               139               133                 3
cat("\n Percent female, male, expired, Prefer not to say: \n",
    139/nrow(demogs),
    133/nrow(demogs),
    1/nrow(demogs),
    3/nrow(demogs))
## 
##  Percent female, male, expired, Prefer not to say: 
##  0.5036232 0.4818841 0.003623188 0.01086957
table(demogs$Ethnicity.simplified)
## 
##        Asian        Black DATA_EXPIRED        Mixed        Other        White 
##           12           26            4           19           12          203
cat("\n % Asian, Black,      expired,   Mixed,     Other,     White: \n",
    12/nrow(demogs),
    26/nrow(demogs),
    4/nrow(demogs),
    19/nrow(demogs),
    12/nrow(demogs),
    203/nrow(demogs)
    )
## 
##  % Asian, Black,      expired,   Mixed,     Other,     White: 
##  0.04347826 0.0942029 0.01449275 0.06884058 0.04347826 0.7355072

Mean delay by set size

learn_df %>% group_by(set_size) %>% summarize(mean(delay, na.rm=TRUE))
## # A tibble: 5 × 2
##   set_size `mean(delay, na.rm = TRUE)`
##      <int>                       <dbl>
## 1        1                       0    
## 2        2                       0.832
## 3        3                       1.67 
## 4        4                       2.48 
## 5        5                       3.33

Load parameter results from best model

## Write into one file and confirm 8/1/24 bug fix was minor 
# 11325 and 15031 are the 8/1/24 runs with the minor bug/illogical scaling of epsilon correct
# m35_v1 <- read.csv("../model_res/opt/best/BEST__RunRLWMPRew11325.csv")
# m35_v2 <- read.csv("../model_res/opt/best/BEST__RunRLWMPRew15031.csv")
#ComparePars(m35_v1$nll, m35_v2$nll) # confirm essentially identical  
#m35 <- rbind(m35_v1, m35_v2) %>% group_by(ID) %>% slice(which.min(nll)) 
# And basically identical to older version confirming was a minor bug  
# m35_old <- read.csv("../model_res/opt/best/before_8-1-reruns/BEST_m35_RunRLWMPRew.csv")
# ComparePars(m35$nll, m35_old$nll) # confirm essentially identical  
#write.csv(m35, "../model_res/opt/best/BEST__m35_RunRLWMPRew-8-1-24-epsilonfixed.csv")
m35 <- read.csv("../model_res/opt/best/BEST__m35_RunRLWMPRew-8-1-24-epsilonfixed.csv") # the final model with the bug/nonsensical implementation of epsilon fixed on 8/1
learn_m <- learn_df %>% group_by(ID) %>% summarize(m=mean(correct))
test_m <- test_df %>% group_by(ID) %>% summarize(m=mean(correct))

assert(all(learn_m$ID==m35$ID))
assert(all(test_m$ID==m35$ID))

And simulations from model

m35_s <- 
  read.csv("../model_res/sims/SIM_RunRLWMPRew53679.csv")

N simulations

length(unique(m35_s$iter)) 
## [1] 50
m35_s_learn <- m35_s %>% filter(type=="learning")
m35_s_test <- m35_s %>% filter(type=="test")

Figure 2 and associated stats — correct (ie. reward) learning curves and capture by model, RT, and train-test correlation by set size

Plot the empirical proportion correct and its capture by the model

pcor_ss <- data.frame(learn_df %>% 
                        group_by(set_size, stim_iter, ID) %>% summarize(m=mean(correct)))
## `summarise()` has grouped output by 'set_size', 'stim_iter'. You can override
## using the `.groups` argument.
pcor_ss_err <- Rmisc::summarySEwithin(pcor_ss,
                        measurevar = "m",
                        withinvars = c("set_size", "stim_iter"),
                        idvar = "ID")
## Automatically converting the following non-factors to factors: set_size, stim_iter
pcor_ss_m <- data.frame(learn_df %>%
                        group_by(set_size, stim_iter) %>% summarize(m=mean(correct)))
## `summarise()` has grouped output by 'set_size'. You can override using the
## `.groups` argument.
emp_p1 <- ggplot(pcor_ss_err, aes(x=stim_iter, y=m, group=as.factor(set_size), color=as.factor(set_size))) + 
  geom_line() + 
  geom_ribbon(aes(ymin=m-se, ymax=m+se), fill='gray57', alpha=.45) + 
          geom_hline(yintercept=.33, size=1.5, color="gray57") + # chance line 
          geom_hline(yintercept=c(.5, .6, .7, .8, .9, 1), linetype="dotted") +
          geom_vline(xintercept=c(2, 5, 8, 10), linetype="dotted") +
          geom_point(aes(fill=as.factor(set_size)), color="black", size=5, pch=21) + 
  annotate("rect", xmin=6, xmax=10.5, ymin=.3, ymax=1.1, alpha=0.2, fill="gray57") +
  ga + ap + lp + xlab("Stimulus iteration") + ylab("Proportion correct") + tol + 
  ggtitle("Empirical") + tp
## Warning: Using `size` aesthetic for lines was deprecated in ggplot2 3.4.0.
## ℹ Please use `linewidth` instead.
## This warning is displayed once every 8 hours.
## Call `lifecycle::last_lifecycle_warnings()` to see where this warning was
## generated.
# Confirm summarySEwithin m and un-normed one are essentially the same 
pcor_ss_m <- data.frame(learn_df %>%
                        group_by(set_size, stim_iter) %>% summarize(m=mean(correct)))
## `summarise()` has grouped output by 'set_size'. You can override using the
## `.groups` argument.
assert(all(round(pcor_ss_err$m, 4)==round(pcor_ss_m$m, 4)))
pcor_ss_sim_m35 <- data.frame(m35_s_learn %>% group_by(set_size, stim_iter) %>%
                        summarize(m=mean(corrects), n()))
## `summarise()` has grouped output by 'set_size'. You can override using the
## `.groups` argument.
pcor_ss_sim_m35_iter <- data.frame(m35_s_learn %>% filter(iter %in% c(1:30)) %>%  group_by(stim_iter, set_size, iter) %>%
                        summarize(m=mean(corrects), n()))
## `summarise()` has grouped output by 'stim_iter', 'set_size'. You can override
## using the `.groups` argument.
sim_m35_p1 <- 
  ggplot(pcor_ss_sim_m35, aes(x=as.factor(stim_iter), y=m, group=as.factor(set_size), color=as.factor(set_size))) + 
  geom_line() + 
  geom_hline(yintercept=.33, size=1.5, color="gray57") + # chance line 
  geom_hline(yintercept=c(.5, .6, .7, .8, .9, 1), linetype="dotted") +
  geom_vline(xintercept=c(2, 5, 8, 10), linetype="dotted") +
  geom_jitter(data=pcor_ss_sim_m35_iter, aes(fill=as.factor(set_size)), color="black", height=0, width=.2, alpha=1,  size=2, pch=21) + 
  geom_point(aes(fill=as.factor(set_size)), color="black", size=6, pch=21, alpha=.7) + 
  annotate("rect", xmin=6, xmax=10.5, ymin=.3, ymax=1.1, alpha=0.2, fill="gray57") +
  ga + ap + lp + xlab("Stimulus iteration") + ylab("") + 
  tp + ggtitle("Simulated")
emp_sim_perf <- emp_p1 + sim_m35_p1 
emp_sim_perf

#ggsave("../paper/figs/pieces/fig2_emp_sim_perf.png", emp_sim_perf, height = 3.5, width=11, dpi=300)

Before/after break regressor

end_p1_begin_p2_df <- learn_df %>% filter(stim_iter %in% c(5, 6))
#end_p1_begin_p2_df$before_after_break <- end_p1_begin_p2_df$stim_iter
end_p1_begin_p2_df[end_p1_begin_p2_df$stim_iter==5, "before_after_break"] <- -1
end_p1_begin_p2_df[end_p1_begin_p2_df$stim_iter==6, "before_after_break"] <- 1

Statistical models of performance effect

Main effects of set size and stim iter and interaction reflecting parametric effect over time in both phase 1 and phase 2

summary(pcor_phase_1_v2 <-
          glmer(correct ~ scale(set_size)*scale(stim_iter) + 
                (scale(set_size)*scale(stim_iter)|ID), 
                data=learn_df %>% filter(phase==1), 
                family="binomial", control = glmerControl(optimizer = "bobyqa")))  
## Generalized linear mixed model fit by maximum likelihood (Laplace
##   Approximation) [glmerMod]
##  Family: binomial  ( logit )
## Formula: correct ~ scale(set_size) * scale(stim_iter) + (scale(set_size) *  
##     scale(stim_iter) | ID)
##    Data: learn_df %>% filter(phase == 1)
## Control: glmerControl(optimizer = "bobyqa")
## 
##      AIC      BIC   logLik deviance df.resid 
##  44084.9  44205.7 -22028.5  44056.9    41236 
## 
## Scaled residuals: 
##      Min       1Q   Median       3Q      Max 
## -11.8169  -0.7807   0.3279   0.6811   1.7107 
## 
## Random effects:
##  Groups Name                             Variance Std.Dev. Corr             
##  ID     (Intercept)                      0.19502  0.4416                    
##         scale(set_size)                  0.04951  0.2225   -0.08            
##         scale(stim_iter)                 0.10059  0.3172    0.90 -0.23      
##         scale(set_size):scale(stim_iter) 0.02250  0.1500   -0.16  0.69 -0.53
## Number of obs: 41250, groups:  ID, 275
## 
## Fixed effects:
##                                  Estimate Std. Error z value Pr(>|z|)    
## (Intercept)                       0.99731    0.03038   32.83   <2e-16 ***
## scale(set_size)                  -0.54013    0.02075  -26.03   <2e-16 ***
## scale(stim_iter)                  1.07075    0.02424   44.18   <2e-16 ***
## scale(set_size):scale(stim_iter) -0.37241    0.01824  -20.42   <2e-16 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Correlation of Fixed Effects:
##             (Intr) scl(st_s) scl(stm_)
## scal(st_sz) -0.201                    
## scl(stm_tr)  0.774 -0.297             
## scl(s_):(_) -0.228  0.587    -0.417
summary(pcor_phase_2_v2 <- 
          glmer(correct ~ scale(set_size)*scale(stim_iter) + 
                  (scale(set_size)*scale(stim_iter)|ID), 
                data=learn_df %>% filter(phase==2), 
                family="binomial", control = glmerControl(optimizer = "bobyqa")))  
## Generalized linear mixed model fit by maximum likelihood (Laplace
##   Approximation) [glmerMod]
##  Family: binomial  ( logit )
## Formula: correct ~ scale(set_size) * scale(stim_iter) + (scale(set_size) *  
##     scale(stim_iter) | ID)
##    Data: learn_df %>% filter(phase == 2)
## Control: glmerControl(optimizer = "bobyqa")
## 
##      AIC      BIC   logLik deviance df.resid 
##  32506.6  32627.4 -16239.3  32478.6    41236 
## 
## Scaled residuals: 
##     Min      1Q  Median      3Q     Max 
## -9.0386  0.1654  0.3001  0.4631  1.3998 
## 
## Random effects:
##  Groups Name                             Variance Std.Dev. Corr             
##  ID     (Intercept)                      0.61266  0.7827                    
##         scale(set_size)                  0.11233  0.3352    0.57            
##         scale(stim_iter)                 0.02303  0.1517    0.56  0.36      
##         scale(set_size):scale(stim_iter) 0.01768  0.1330    0.26  0.24 -0.56
## Number of obs: 41250, groups:  ID, 275
## 
## Fixed effects:
##                                  Estimate Std. Error z value Pr(>|z|)    
## (Intercept)                       2.02297    0.05113  39.568   <2e-16 ***
## scale(set_size)                  -0.28678    0.02877  -9.969   <2e-16 ***
## scale(stim_iter)                  0.69938    0.02066  33.849   <2e-16 ***
## scale(set_size):scale(stim_iter) -0.25844    0.02082 -12.410   <2e-16 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Correlation of Fixed Effects:
##             (Intr) scl(st_s) scl(stm_)
## scal(st_sz)  0.298                    
## scl(stm_tr)  0.410 -0.049             
## scl(s_):(_)  0.003  0.436    -0.291
# Singular
# summary(pcor_before_after <- 
#           glmer(correct ~ scale(set_size)*scale(before_after_break) + 
#                   (scale(set_size)*scale(before_after_break)|ID), 
#                 data=end_p1_begin_p2_df, 
#                 family="binomial", control = glmerControl(optimizer = "bobyqa")))  

summary(pcor_before_after <- 
          glmer(correct ~ scale(set_size)*scale(before_after_break) + 
                  (scale(set_size) + scale(before_after_break)|ID), 
                data=end_p1_begin_p2_df, 
                family="binomial", control = glmerControl(optimizer = "bobyqa")))  
## Generalized linear mixed model fit by maximum likelihood (Laplace
##   Approximation) [glmerMod]
##  Family: binomial  ( logit )
## Formula: 
## correct ~ scale(set_size) * scale(before_after_break) + (scale(set_size) +  
##     scale(before_after_break) | ID)
##    Data: end_p1_begin_p2_df
## Control: glmerControl(optimizer = "bobyqa")
## 
##      AIC      BIC   logLik deviance df.resid 
##  16446.4  16523.6  -8213.2  16426.4    16490 
## 
## Scaled residuals: 
##     Min      1Q  Median      3Q     Max 
## -5.7814  0.1644  0.3936  0.5720  1.5714 
## 
## Random effects:
##  Groups Name                      Variance Std.Dev. Corr       
##  ID     (Intercept)               0.421477 0.64921             
##         scale(set_size)           0.068597 0.26191   0.31      
##         scale(before_after_break) 0.002658 0.05156   0.34 -0.44
## Number of obs: 16500, groups:  ID, 275
## 
## Fixed effects:
##                                           Estimate Std. Error z value Pr(>|z|)
## (Intercept)                                1.41359    0.04558   31.02   <2e-16
## scale(set_size)                           -0.29171    0.02908  -10.03   <2e-16
## scale(before_after_break)                 -0.52282    0.02316  -22.58   <2e-16
## scale(set_size):scale(before_after_break)  0.37378    0.02349   15.91   <2e-16
##                                              
## (Intercept)                               ***
## scale(set_size)                           ***
## scale(before_after_break)                 ***
## scale(set_size):scale(before_after_break) ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Correlation of Fixed Effects:
##             (Intr) scl(_) sc(__)
## scal(st_sz)  0.025              
## scl(bfr_f_) -0.146  0.229       
## scl(_):(__)  0.156 -0.362 -0.277
car::vif(pcor_before_after)
##                           scale(set_size) 
##                                  1.174968 
##                 scale(before_after_break) 
##                                  1.105577 
## scale(set_size):scale(before_after_break) 
##                                  1.205734
car::vif(pcor_phase_2_v2)
##                  scale(set_size)                 scale(stim_iter) 
##                         1.245388                         1.101492 
## scale(set_size):scale(stim_iter) 
##                         1.357267
car::vif(pcor_phase_1_v2)
##                  scale(set_size)                 scale(stim_iter) 
##                         1.533658                         1.216770 
## scale(set_size):scale(stim_iter) 
##                         1.692973

Logistic model predictions are a bit mis-specified but decent

sjPlot::plot_model(pcor_phase_1_v2, 
                   type = "pred", terms = c("stim_iter", "set_size")) + 
  ga + ap + lp + tp + xlab("Stimulus iteration") + 
  ylab("Proportion correct") + ggtitle("Phase 1 regression model predictions")

sjPlot::tab_model(pcor_phase_1_v2)
  correct
Predictors Odds Ratios CI p
(Intercept) 2.71 2.55 – 2.88 <0.001
set size 0.58 0.56 – 0.61 <0.001
stim iter 2.92 2.78 – 3.06 <0.001
set size × stim iter 0.69 0.66 – 0.71 <0.001
Random Effects
σ2 3.29
τ00 ID 0.20
τ11 ID.scale(set_size) 0.05
τ11 ID.scale(stim_iter) 0.10
τ11 ID.scale(set_size):scale(stim_iter) 0.02
ρ01 -0.08
0.90
-0.16
ICC 0.10
N ID 275
Observations 41250
Marginal R2 / Conditional R2 0.301 / 0.371 
sjPlot::plot_model(pcor_phase_2_v2, 
                   type = "pred", terms = c("stim_iter", "set_size")) + 
  ga + ap + lp + tp + xlab("Stimulus iteration") + 
  ylab("Proportion correct") + ggtitle("Phase 2 regression model predictions")

sjPlot::tab_model(pcor_phase_2_v2)
  correct
Predictors Odds Ratios CI p
(Intercept) 7.56 6.84 – 8.36 <0.001
set size 0.75 0.71 – 0.79 <0.001
stim iter 2.01 1.93 – 2.10 <0.001
set size × stim iter 0.77 0.74 – 0.80 <0.001
Random Effects
σ2 3.29
τ00 ID 0.61
τ11 ID.scale(set_size) 0.11
τ11 ID.scale(stim_iter) 0.02
τ11 ID.scale(set_size):scale(stim_iter) 0.02
ρ01 0.57
0.56
0.26
ICC 0.19
N ID 275
Observations 41250
Marginal R2 / Conditional R2 0.136 / 0.299 
pcor_before_after_p <- sjPlot::plot_model(pcor_before_after, 
                   type = "pred", terms = c("before_after_break", "set_size")) + 
  ga + ap + lp + tp + xlab("Stimulus iteration") + 
  ylab("Proportion correct") + ggtitle("Before to after break regression model predictions")
pcor_before_after_p 

sjPlot::tab_model(pcor_before_after)
  correct
Predictors Odds Ratios CI p
(Intercept) 4.11 3.76 – 4.49 <0.001
set size 0.75 0.71 – 0.79 <0.001
before after break 0.59 0.57 – 0.62 <0.001
set size × before after
break 		1.45 1.39 – 1.52 <0.001
Random Effects
σ2 3.29
τ00 ID 0.42
τ11 ID.scale(set_size) 0.07
τ11 ID.scale(before_after_break) 0.00
ρ01 0.31
0.34
ICC 0.13
N ID 275
Observations 16500
Marginal R2 / Conditional R2 0.116 / 0.231 
#ggsave("../paper/figs/supp-figs/pcor_before_after_p.png", pcor_before_after_p, height = 5, width=11, dpi=300)

Reaction times during the learning phase

Trial 1 so there’s def no S-A-O load on WM

rt_trial_1 <- data.frame(learn_df %>% filter(stim_iter==1) %>% 
                           group_by(set_size, ID) %>% summarize(m=mean(rt)))
## `summarise()` has grouped output by 'set_size'. You can override using the
## `.groups` argument.
rt_trial_1_m <- data.frame(learn_df %>% filter(stim_iter==1) %>% 
                           group_by(set_size) %>% summarize(m=mean(rt)))

rt_tr1_err <- Rmisc::summarySEwithin(rt_trial_1,
                        measurevar = "m",
                        withinvars = c("set_size"),
                        idvar = "ID")
## Automatically converting the following non-factors to factors: set_size
assert(all(round(rt_tr1_err$m, 4)==round(rt_trial_1_m$m, 4)))
emp_rt_tr_1 <- ggplot(rt_tr1_err , 
         aes(x=set_size, y=m, group=as.factor(set_size), fill=as.factor(set_size))) + 
  geom_errorbar(aes(x=set_size, ymin=m-se, ymax=m+se), size=1.5, width=.25) +
  geom_point(size=6, pch=21, color="black", alpha=.7) + 
  
  ga + ap + lp + xlab("Set size") + ylab("") + 
  ggtitle("At trial 1") + tp + tol#+ ylim(600, 900)
rt_ss_si6 <- data.frame(learn_df %>% filter(stim_iter==6) %>%  
                          group_by(set_size, ID) %>% summarize(m=mean(rt)))
## `summarise()` has grouped output by 'set_size'. You can override using the
## `.groups` argument.
rt_ss_si6_m <- data.frame(learn_df %>% filter(stim_iter==6) %>%  
                          group_by(set_size) %>% summarize(m=mean(rt)))


rt_ss_si6_err <- Rmisc::summarySEwithin(rt_ss_si6,
                        measurevar = "m",
                        withinvars = c("set_size"),
                        idvar = "ID")
## Automatically converting the following non-factors to factors: set_size
assert(all(round(rt_ss_si6_err$m, 4)==round(rt_ss_si6_m$m, 4)))
emp_rt_si_6 <- ggplot(rt_ss_si6_err , 
         aes(x=set_size, y=m, group=as.factor(set_size), fill=as.factor(set_size))) + 
  
  
  geom_errorbar(aes(x=set_size, ymin=m-se, ymax=m+se), size=1.5, width=.25) +
  geom_point(size=6, pch=21, color="black", alpha=.7) + 
  
  ga + ap + lp + xlab("Set size") + ylab("") + 
  ggtitle("At stimulus iteration 6") + tp  + tol
rt_ss_si6_df <- data.frame(learn_df %>% filter(stim_iter==6))
rt_ss_si6_df$set_size_indicator <- if_else(rt_ss_si6_df$set_size==1, 1, -1)
# Reduced because model without RE did not converge 
summary(rt_ss_si6_df_model <- 
          lmer(rt ~ set_size_indicator + (1|ID), data=rt_ss_si6_df))
## Linear mixed model fit by REML. t-tests use Satterthwaite's method [
## lmerModLmerTest]
## Formula: rt ~ set_size_indicator + (1 | ID)
##    Data: rt_ss_si6_df
## 
## REML criterion at convergence: 111694.6
## 
## Scaled residuals: 
##     Min      1Q  Median      3Q     Max 
## -3.5966 -0.6484 -0.0592  0.6007  3.7289 
## 
## Random effects:
##  Groups   Name        Variance Std.Dev.
##  ID       (Intercept)  7416     86.11  
##  Residual             41809    204.47  
## Number of obs: 8250, groups:  ID, 275
## 
## Fixed effects:
##                    Estimate Std. Error       df t value Pr(>|t|)    
## (Intercept)         737.512      6.880  593.431  107.20   <2e-16 ***
## set_size_indicator   49.475      4.512 7974.000   10.96   <2e-16 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Correlation of Fixed Effects:
##             (Intr)
## st_sz_ndctr 0.568
rt_ss <- data.frame(learn_df %>% group_by(set_size, stim_iter, ID) %>% summarize(m=mean(rt)))
## `summarise()` has grouped output by 'set_size', 'stim_iter'. You can override
## using the `.groups` argument.
rt_ss_m <- data.frame(learn_df %>% 
                        group_by(set_size, stim_iter) %>% summarize(m=mean(rt))) 
## `summarise()` has grouped output by 'set_size'. You can override using the
## `.groups` argument.
rt_ss_err <- Rmisc::summarySEwithin(rt_ss,
                        measurevar = "m",
                        withinvars = c("set_size", "stim_iter"),
                        idvar = "ID")
## Automatically converting the following non-factors to factors: set_size, stim_iter
assert(all(round(rt_ss_err$m, 4)==round(rt_ss_m$m, 4)))

emp_rt <- 
  ggplot(rt_ss_err, aes(x=stim_iter, y=m, group=as.factor(set_size), color=as.factor(set_size))) + 
  
  geom_line() +
  geom_ribbon(aes(ymin=m-se, ymax=m+se), fill='gray57', alpha=.45) +
          geom_vline(xintercept=c(3, 7, 9), linetype="dotted") +

          geom_point(aes(fill=as.factor(set_size)), color="black", size=5, pch=21) +
  annotate("rect", xmin=6, xmax=10.5, ymin=300, ymax=850, alpha=0.2, fill="gray57") +
  ga + ap + lp + xlab("Stimulus iteration") + ylab("Reaction time") + tol + 
  ggtitle("Overall") + tp 
rt_ss_d0_r1 <- 
  data.frame(learn_df %>% filter(delay==0 & past_reward == 1) %>% 
               group_by(set_size, stim_iter, ID) %>% summarize(m=mean(rt)))
## `summarise()` has grouped output by 'set_size', 'stim_iter'. You can override
## using the `.groups` argument.
rt_ss_d0_r1_m <-   data.frame(learn_df %>% filter(delay==0 & past_reward == 1) %>% 
               group_by(set_size, stim_iter) %>% summarize(m=mean(rt)))
## `summarise()` has grouped output by 'set_size'. You can override using the
## `.groups` argument.
rt_ss_err_d0_r1 <- Rmisc::summarySEwithin(rt_ss_d0_r1,
                        measurevar = "m",
                        withinvars = c("set_size", "stim_iter"),
                        idvar = "ID")
## Automatically converting the following non-factors to factors: set_size, stim_iter
assert(all(round(rt_ss_err_d0_r1$m, 4)==round(rt_ss_err_d0_r1$m, 4)))

emp_rt_d0_r1 <- ggplot(rt_ss_err_d0_r1, aes(x=stim_iter, y=m, group=as.factor(set_size), color=as.factor(set_size))) + 
  geom_line() + 
  geom_ribbon(aes(ymin=m-se, ymax=m+se), fill='gray57', alpha=.45) + 
          geom_vline(xintercept=c(2, 5, 7), linetype="dotted") +
          geom_point(aes(fill=as.factor(set_size)), color="black", size=5, pch=21) + 
  annotate("rect", xmin=5, xmax=8.5, ymin=300, ymax=630, alpha=0.2, fill="gray57") +
  ga + ap + lp + xlab("Stimulus iteration") + ylab("") + 
  ggtitle("When prior reward and no delay") + tp + tol #+ ylim(300, 900) 
rt_nodrew <- learn_df %>% filter(delay==0 & past_reward == 1)
summary(rt_nodrew_model <- 
          lmer(rt ~ scale(set_size) + (scale(set_size)|ID), data=rt_nodrew))
## Linear mixed model fit by REML. t-tests use Satterthwaite's method [
## lmerModLmerTest]
## Formula: rt ~ scale(set_size) + (scale(set_size) | ID)
##    Data: rt_nodrew
## 
## REML criterion at convergence: 239851.2
## 
## Scaled residuals: 
##     Min      1Q  Median      3Q     Max 
## -4.1271 -0.6197 -0.1287  0.4544  6.7795 
## 
## Random effects:
##  Groups   Name            Variance Std.Dev. Corr 
##  ID       (Intercept)      4851.9   69.66        
##           scale(set_size)   480.4   21.92   -0.08
##  Residual                 20929.7  144.67        
## Number of obs: 18678, groups:  ID, 275
## 
## Fixed effects:
##                 Estimate Std. Error      df t value Pr(>|t|)    
## (Intercept)      480.237      4.334 274.098  110.81   <2e-16 ***
## scale(set_size)   67.556      1.699 271.451   39.76   <2e-16 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Correlation of Fixed Effects:
##             (Intr)
## scal(st_sz) -0.059
all_rt <- 
  emp_rt + emp_rt_d0_r1 + emp_rt_tr_1 + emp_rt_si_6 + plot_annotation(title="Empirical reaction time", theme = theme(plot.title = element_text(size = 25, hjust=.5)))#, size=10)
all_rt

#ggsave("../paper/figs/pieces/fig2_emp_rt.png", all_rt, height = 6, width=11, dpi=300)

Confirms strong set size effect even at first stim iter — suggesting different proactive strategies

summary(rt_si_1 <- 
          lmer(rt ~ scale(set_size) + (scale(set_size)|ID), data=learn_df %>% filter(stim_iter==1)))
## Linear mixed model fit by REML. t-tests use Satterthwaite's method [
## lmerModLmerTest]
## Formula: rt ~ scale(set_size) + (scale(set_size) | ID)
##    Data: learn_df %>% filter(stim_iter == 1)
## 
## REML criterion at convergence: 112275.7
## 
## Scaled residuals: 
##     Min      1Q  Median      3Q     Max 
## -4.1250 -0.6697 -0.0766  0.5833  4.1575 
## 
## Random effects:
##  Groups   Name            Variance Std.Dev. Corr
##  ID       (Intercept)      9725     98.62       
##           scale(set_size)  1063     32.61   0.31
##  Residual                 43818    209.33       
## Number of obs: 8250, groups:  ID, 275
## 
## Fixed effects:
##                 Estimate Std. Error      df t value Pr(>|t|)    
## (Intercept)      716.300      6.378 274.026   112.3   <2e-16 ***
## scale(set_size)   37.568      3.030 273.996    12.4   <2e-16 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Correlation of Fixed Effects:
##             (Intr)
## scal(st_sz) 0.188
sjPlot::tab_model(rt_si_1)
  rt
Predictors Estimates CI p
(Intercept) 716.30 703.80 – 728.80 <0.001
set size 37.57 31.63 – 43.51 <0.001
Random Effects
σ2 43818.07
τ00 ID 9725.25
τ11 ID.scale(set_size) 1063.36
ρ01 ID 0.31
ICC 0.20
N ID 275
Observations 8250
Marginal R2 / Conditional R2 0.025 / 0.218

Regression models in phase 1 and phase 2 show main effects of set size and stim iter and an interaction in both phases

(REs complexity reduce due to convergence failure with full)

summary(rt_p1 <- 
          lmer(rt ~ scale(set_size)*scale(stim_iter) + 
                 (scale(set_size) + scale(stim_iter)|ID), 
               data=learn_df %>% filter(phase==1)))
## Linear mixed model fit by REML. t-tests use Satterthwaite's method [
## lmerModLmerTest]
## Formula: rt ~ scale(set_size) * scale(stim_iter) + (scale(set_size) +  
##     scale(stim_iter) | ID)
##    Data: learn_df %>% filter(phase == 1)
## 
## REML criterion at convergence: 558890.9
## 
## Scaled residuals: 
##     Min      1Q  Median      3Q     Max 
## -4.0355 -0.6793 -0.1269  0.5603  4.7845 
## 
## Random effects:
##  Groups   Name             Variance Std.Dev. Corr       
##  ID       (Intercept)       6923.2   83.21              
##           scale(set_size)    951.4   30.84    0.33      
##           scale(stim_iter)   428.5   20.70   -0.20 -0.18
##  Residual                  43257.6  207.98              
## Number of obs: 41250, groups:  ID, 275
## 
## Fixed effects:
##                                   Estimate Std. Error        df t value
## (Intercept)                        648.359      5.121   274.006  126.61
## scale(set_size)                     88.066      2.123   274.000   41.48
## scale(stim_iter)                   -38.968      1.615   274.014  -24.14
## scale(set_size):scale(stim_iter)    18.135      1.024 40424.000   17.71
##                                  Pr(>|t|)    
## (Intercept)                        <2e-16 ***
## scale(set_size)                    <2e-16 ***
## scale(stim_iter)                   <2e-16 ***
## scale(set_size):scale(stim_iter)   <2e-16 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Correlation of Fixed Effects:
##             (Intr) scl(st_s) scl(stm_)
## scal(st_sz)  0.286                    
## scl(stm_tr) -0.154 -0.124             
## scl(s_):(_)  0.000  0.000     0.000
sjPlot::tab_model(rt_p1)
  rt
Predictors Estimates CI p
(Intercept) 648.36 638.32 – 658.40 <0.001
set size 88.07 83.90 – 92.23 <0.001
stim iter -38.97 -42.13 – -35.80 <0.001
set size × stim iter 18.13 16.13 – 20.14 <0.001
Random Effects
σ2 43257.63
τ00 ID 6923.16
τ11 ID.scale(set_size) 951.39
τ11 ID.scale(stim_iter) 428.50
ρ01 0.33
-0.20
ICC 0.16
N ID 275
Observations 41250
Marginal R2 / Conditional R2 0.157 / 0.293 
sjPlot::plot_model(rt_p1, type = "pred", terms = c("stim_iter", "set_size")) + 
  ga + ap + lp + tp + xlab("Stimulus iteration") + ylab("Reaction time") + ggtitle("Phase 1 regression model predictions")

summary(rt_p2 <-lmer(rt ~ scale(set_size)*scale(stim_iter) + (scale(set_size) + scale(stim_iter)|ID), data=learn_df %>% filter(phase==2)))
## Linear mixed model fit by REML. t-tests use Satterthwaite's method [
## lmerModLmerTest]
## Formula: rt ~ scale(set_size) * scale(stim_iter) + (scale(set_size) +  
##     scale(stim_iter) | ID)
##    Data: learn_df %>% filter(phase == 2)
## 
## REML criterion at convergence: 545785.3
## 
## Scaled residuals: 
##     Min      1Q  Median      3Q     Max 
## -4.5886 -0.6438 -0.1083  0.5057  7.5230 
## 
## Random effects:
##  Groups   Name             Variance Std.Dev. Corr       
##  ID       (Intercept)       6462.4   80.39              
##           scale(set_size)    626.8   25.04    0.28      
##           scale(stim_iter)   143.2   11.97   -0.12 -0.19
##  Residual                  31520.5  177.54              
## Number of obs: 41250, groups:  ID, 275
## 
## Fixed effects:
##                                    Estimate Std. Error         df t value
## (Intercept)                        580.8416     4.9258   273.9913  117.92
## scale(set_size)                     57.9437     1.7445   274.0246   33.22
## scale(stim_iter)                   -40.3142     1.1336   273.9947  -35.56
## scale(set_size):scale(stim_iter)    19.6083     0.8742 40423.9930   22.43
##                                  Pr(>|t|)    
## (Intercept)                        <2e-16 ***
## scale(set_size)                    <2e-16 ***
## scale(stim_iter)                   <2e-16 ***
## scale(set_size):scale(stim_iter)   <2e-16 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Correlation of Fixed Effects:
##             (Intr) scl(st_s) scl(stm_)
## scal(st_sz)  0.234                    
## scl(stm_tr) -0.075 -0.104             
## scl(s_):(_)  0.000  0.000     0.000
car::vif(rt_p1)
##                  scale(set_size)                 scale(stim_iter) 
##                         1.015515                         1.015515 
## scale(set_size):scale(stim_iter) 
##                         1.000000
car::vif(rt_p2)
##                  scale(set_size)                 scale(stim_iter) 
##                         1.010985                         1.010985 
## scale(set_size):scale(stim_iter) 
##                         1.000000
sjPlot::tab_model(rt_p2)
  rt
Predictors Estimates CI p
(Intercept) 580.84 571.19 – 590.50 <0.001
set size 57.94 54.52 – 61.36 <0.001
stim iter -40.31 -42.54 – -38.09 <0.001
set size × stim iter 19.61 17.89 – 21.32 <0.001
Random Effects
σ2 31520.54
τ00 ID 6462.37
τ11 ID.scale(set_size) 626.77
τ11 ID.scale(stim_iter) 143.23
ρ01 0.28
-0.12
ICC 0.19
N ID 275
Observations 41250
Marginal R2 / Conditional R2 0.122 / 0.286 
sjPlot::plot_model(rt_p2, type = "pred", terms = c("stim_iter", "set_size")) + 
  ga + ap + lp + tp + xlab("Stimulus iteration") + ylab("Reaction time") + ggtitle("Phase 2 regression model predictions")

Correlation between learning and test phase

learn_ms <- data.frame(learn_df %>% 
                         group_by(ID, set_size) %>% summarize(learn_m=mean(correct)))
## `summarise()` has grouped output by 'ID'. You can override using the `.groups`
## argument.
test_ms <- data.frame(test_df %>% 
                        group_by(ID, set_size) %>% summarize(test_m=mean(correct)))
## `summarise()` has grouped output by 'ID'. You can override using the `.groups`
## argument.
assert(all(test_ms$ID==learn_ms$ID))
test_ms$learn_m <- learn_ms$learn_m
emp_corrs <- ggplot(test_ms, 
                    aes(x=learn_m, y=test_m, color=as.factor(set_size))) + 
  geom_jitter(alpha=.4, size=2, width=.02) + 
  ggpubr::stat_cor(method="spearman", size=5, label.y=1.12) + ga + ft + ap + 
  xlab("Learning") + ylab("Test") + facet_wrap(~ set_size, nrow=1) + tol + 
  xlim(0, 1) + ylim(0, 1.17)  + 
  theme(axis.text = element_blank(), axis.ticks = element_blank()) + theme(axis.title = element_text(size=17)) +
  ggtitle(expression(italic("Empirical"))) + tp

Take one simulation iter to match number used empirically and not “smooth” by more sims

learn_ms_s <- data.frame(m35_s_learn %>% filter(iter==1) %>%  group_by(ID, set_size) %>% summarize(learn_m=mean(corrects)))
## `summarise()` has grouped output by 'ID'. You can override using the `.groups`
## argument.
test_ms_s <- data.frame(m35_s_test %>%  filter(iter==1) %>% group_by(ID, set_size) %>% summarize(test_m=mean(corrects)))
## `summarise()` has grouped output by 'ID'. You can override using the `.groups`
## argument.
assert(all(test_ms_s$ID==learn_ms_s$ID))

test_ms_s$learn_m <- learn_ms_s$learn_m

sim_corrs <- ggplot(test_ms_s, aes(x=learn_m, y=test_m, color=as.factor(set_size))) + geom_jitter(alpha=.4, size=2, width=.0) + 
  ggpubr::stat_cor(method="spearman", size=5, label.y=1.12) + ga + ft + ap + 
  xlab("Learning") + ylab("Test") + facet_wrap(~ set_size, nrow=1) + tol + 
  xlim(0, 1) + ylim(0, 1.17)  +
  theme(axis.text = element_blank(), axis.ticks = element_blank()) + theme(axis.title = element_text(size=17)) +
  ggtitle(expression(italic("Simulated"))) + tp

To statistically test

higher_in_high_ss <- unlist(foreach (i = unique(m35_s_learn$iter)) %do% {
  learn_ms_s_iter <- NULL; test_ms_s_iter <- NULL; low_ss <- NULL; high_ss <- NULL
  learn_ms_s_iter <- data.frame(m35_s_learn %>% filter(iter==i) %>%  group_by(ID, set_size) %>% summarize(learn_m=mean(corrects)))
  test_ms_s_iter <- data.frame(m35_s_test %>% filter(iter==i) %>%  group_by(ID, set_size) %>% summarize(learn_m=mean(corrects)))
  
  low_ss <- cor.test(
    data.frame(learn_ms_s_iter %>% filter(set_size %in% c(1, 2)))$learn_m,
    data.frame(test_ms_s_iter %>% filter(set_size %in% c(1, 2)))$learn_m
  )
  high_ss <- cor.test(
    data.frame(learn_ms_s_iter %>% filter(set_size %in% c(4, 5)))$learn_m,
    data.frame(test_ms_s_iter %>% filter(set_size %in% c(4, 5)))$learn_m
  )

  binary_out <- (low_ss$estimate < high_ss$estimate)*1  
binary_out
})
## `summarise()` has grouped output by 'ID'. You can override using the `.groups`
## argument.
## `summarise()` has grouped output by 'ID'. You can override using the `.groups`
## argument.
## `summarise()` has grouped output by 'ID'. You can override using the `.groups`
## argument.
## `summarise()` has grouped output by 'ID'. You can override using the `.groups`
## argument.
## `summarise()` has grouped output by 'ID'. You can override using the `.groups`
## argument.
## `summarise()` has grouped output by 'ID'. You can override using the `.groups`
## argument.
## `summarise()` has grouped output by 'ID'. You can override using the `.groups`
## argument.
## `summarise()` has grouped output by 'ID'. You can override using the `.groups`
## argument.
## `summarise()` has grouped output by 'ID'. You can override using the `.groups`
## argument.
## `summarise()` has grouped output by 'ID'. You can override using the `.groups`
## argument.
## `summarise()` has grouped output by 'ID'. You can override using the `.groups`
## argument.
## `summarise()` has grouped output by 'ID'. You can override using the `.groups`
## argument.
## `summarise()` has grouped output by 'ID'. You can override using the `.groups`
## argument.
## `summarise()` has grouped output by 'ID'. You can override using the `.groups`
## argument.
## `summarise()` has grouped output by 'ID'. You can override using the `.groups`
## argument.
## `summarise()` has grouped output by 'ID'. You can override using the `.groups`
## argument.
## `summarise()` has grouped output by 'ID'. You can override using the `.groups`
## argument.
## `summarise()` has grouped output by 'ID'. You can override using the `.groups`
## argument.
## `summarise()` has grouped output by 'ID'. You can override using the `.groups`
## argument.
## `summarise()` has grouped output by 'ID'. You can override using the `.groups`
## argument.
## `summarise()` has grouped output by 'ID'. You can override using the `.groups`
## argument.
## `summarise()` has grouped output by 'ID'. You can override using the `.groups`
## argument.
## `summarise()` has grouped output by 'ID'. You can override using the `.groups`
## argument.
## `summarise()` has grouped output by 'ID'. You can override using the `.groups`
## argument.
## `summarise()` has grouped output by 'ID'. You can override using the `.groups`
## argument.
## `summarise()` has grouped output by 'ID'. You can override using the `.groups`
## argument.
## `summarise()` has grouped output by 'ID'. You can override using the `.groups`
## argument.
## `summarise()` has grouped output by 'ID'. You can override using the `.groups`
## argument.
## `summarise()` has grouped output by 'ID'. You can override using the `.groups`
## argument.
## `summarise()` has grouped output by 'ID'. You can override using the `.groups`
## argument.
## `summarise()` has grouped output by 'ID'. You can override using the `.groups`
## argument.
## `summarise()` has grouped output by 'ID'. You can override using the `.groups`
## argument.
## `summarise()` has grouped output by 'ID'. You can override using the `.groups`
## argument.
## `summarise()` has grouped output by 'ID'. You can override using the `.groups`
## argument.
## `summarise()` has grouped output by 'ID'. You can override using the `.groups`
## argument.
## `summarise()` has grouped output by 'ID'. You can override using the `.groups`
## argument.
## `summarise()` has grouped output by 'ID'. You can override using the `.groups`
## argument.
## `summarise()` has grouped output by 'ID'. You can override using the `.groups`
## argument.
## `summarise()` has grouped output by 'ID'. You can override using the `.groups`
## argument.
## `summarise()` has grouped output by 'ID'. You can override using the `.groups`
## argument.
## `summarise()` has grouped output by 'ID'. You can override using the `.groups`
## argument.
## `summarise()` has grouped output by 'ID'. You can override using the `.groups`
## argument.
## `summarise()` has grouped output by 'ID'. You can override using the `.groups`
## argument.
## `summarise()` has grouped output by 'ID'. You can override using the `.groups`
## argument.
## `summarise()` has grouped output by 'ID'. You can override using the `.groups`
## argument.
## `summarise()` has grouped output by 'ID'. You can override using the `.groups`
## argument.
## `summarise()` has grouped output by 'ID'. You can override using the `.groups`
## argument.
## `summarise()` has grouped output by 'ID'. You can override using the `.groups`
## argument.
## `summarise()` has grouped output by 'ID'. You can override using the `.groups`
## argument.
## `summarise()` has grouped output by 'ID'. You can override using the `.groups`
## argument.
## `summarise()` has grouped output by 'ID'. You can override using the `.groups`
## argument.
## `summarise()` has grouped output by 'ID'. You can override using the `.groups`
## argument.
## `summarise()` has grouped output by 'ID'. You can override using the `.groups`
## argument.
## `summarise()` has grouped output by 'ID'. You can override using the `.groups`
## argument.
## `summarise()` has grouped output by 'ID'. You can override using the `.groups`
## argument.
## `summarise()` has grouped output by 'ID'. You can override using the `.groups`
## argument.
## `summarise()` has grouped output by 'ID'. You can override using the `.groups`
## argument.
## `summarise()` has grouped output by 'ID'. You can override using the `.groups`
## argument.
## `summarise()` has grouped output by 'ID'. You can override using the `.groups`
## argument.
## `summarise()` has grouped output by 'ID'. You can override using the `.groups`
## argument.
## `summarise()` has grouped output by 'ID'. You can override using the `.groups`
## argument.
## `summarise()` has grouped output by 'ID'. You can override using the `.groups`
## argument.
## `summarise()` has grouped output by 'ID'. You can override using the `.groups`
## argument.
## `summarise()` has grouped output by 'ID'. You can override using the `.groups`
## argument.
## `summarise()` has grouped output by 'ID'. You can override using the `.groups`
## argument.
## `summarise()` has grouped output by 'ID'. You can override using the `.groups`
## argument.
## `summarise()` has grouped output by 'ID'. You can override using the `.groups`
## argument.
## `summarise()` has grouped output by 'ID'. You can override using the `.groups`
## argument.
## `summarise()` has grouped output by 'ID'. You can override using the `.groups`
## argument.
## `summarise()` has grouped output by 'ID'. You can override using the `.groups`
## argument.
## `summarise()` has grouped output by 'ID'. You can override using the `.groups`
## argument.
## `summarise()` has grouped output by 'ID'. You can override using the `.groups`
## argument.
## `summarise()` has grouped output by 'ID'. You can override using the `.groups`
## argument.
## `summarise()` has grouped output by 'ID'. You can override using the `.groups`
## argument.
## `summarise()` has grouped output by 'ID'. You can override using the `.groups`
## argument.
## `summarise()` has grouped output by 'ID'. You can override using the `.groups`
## argument.
## `summarise()` has grouped output by 'ID'. You can override using the `.groups`
## argument.
## `summarise()` has grouped output by 'ID'. You can override using the `.groups`
## argument.
## `summarise()` has grouped output by 'ID'. You can override using the `.groups`
## argument.
## `summarise()` has grouped output by 'ID'. You can override using the `.groups`
## argument.
## `summarise()` has grouped output by 'ID'. You can override using the `.groups`
## argument.
## `summarise()` has grouped output by 'ID'. You can override using the `.groups`
## argument.
## `summarise()` has grouped output by 'ID'. You can override using the `.groups`
## argument.
## `summarise()` has grouped output by 'ID'. You can override using the `.groups`
## argument.
## `summarise()` has grouped output by 'ID'. You can override using the `.groups`
## argument.
## `summarise()` has grouped output by 'ID'. You can override using the `.groups`
## argument.
## `summarise()` has grouped output by 'ID'. You can override using the `.groups`
## argument.
## `summarise()` has grouped output by 'ID'. You can override using the `.groups`
## argument.
## `summarise()` has grouped output by 'ID'. You can override using the `.groups`
## argument.
## `summarise()` has grouped output by 'ID'. You can override using the `.groups`
## argument.
## `summarise()` has grouped output by 'ID'. You can override using the `.groups`
## argument.
## `summarise()` has grouped output by 'ID'. You can override using the `.groups`
## argument.
## `summarise()` has grouped output by 'ID'. You can override using the `.groups`
## argument.
## `summarise()` has grouped output by 'ID'. You can override using the `.groups`
## argument.
## `summarise()` has grouped output by 'ID'. You can override using the `.groups`
## argument.
## `summarise()` has grouped output by 'ID'. You can override using the `.groups`
## argument.
## `summarise()` has grouped output by 'ID'. You can override using the `.groups`
## argument.
## `summarise()` has grouped output by 'ID'. You can override using the `.groups`
## argument.
## `summarise()` has grouped output by 'ID'. You can override using the `.groups`
## argument.
## `summarise()` has grouped output by 'ID'. You can override using the `.groups`
## argument.
higher_count <- data.frame("lower"=50-sum(higher_in_high_ss), "higher"=sum(higher_in_high_ss))
higher_count
##   lower higher
## 1     0     50
binom.test(sum(higher_in_high_ss), 50)
## 
##  Exact binomial test
## 
## data:  sum(higher_in_high_ss) and 50
## number of successes = 50, number of trials = 50, p-value = 1.776e-15
## alternative hypothesis: true probability of success is not equal to 0.5
## 95 percent confidence interval:
##  0.9288783 1.0000000
## sample estimates:
## probability of success 
##                      1

A few missing due to jitter and divide by 0

all_corrs <- emp_corrs / sim_corrs
all_corrs
## Warning: Removed 16 rows containing missing values (`geom_point()`).

ggsave("../paper/figs/pieces/fig2_perf_corrs.png", all_corrs, height = 5.4, width=12, dpi=300)
## Warning: Removed 14 rows containing missing values (`geom_point()`).

Test correct (ie. reward)

Empirical

p1_test_trials <- test_df %>% filter(phase==1)
p2_test_trials <- test_df %>% filter(phase==2)

pcor_p1_test <- 
  data.frame(p1_test_trials %>% group_by(set_size, ID) %>% summarize(m=mean(correct)))
## `summarise()` has grouped output by 'set_size'. You can override using the
## `.groups` argument.
pcor_p2_test <- 
  data.frame(p2_test_trials %>% group_by(set_size, ID) %>% summarize(m=mean(correct)))
## `summarise()` has grouped output by 'set_size'. You can override using the
## `.groups` argument.
pcor_si6 <- learn_df %>% filter(stim_iter==6) %>% 
  group_by(set_size, ID) %>% summarize(m=mean(correct))
## `summarise()` has grouped output by 'set_size'. You can override using the
## `.groups` argument.
pcor_p1_test_err <- Rmisc::summarySEwithin(pcor_p1_test,
                        measurevar = "m",
                        withinvars = c("set_size"),
                        idvar = "ID")
## Automatically converting the following non-factors to factors: set_size
pcor_si6_err <- Rmisc::summarySEwithin(pcor_si6,
                        measurevar = "m",
                        withinvars = c("set_size"),
                        idvar = "ID")
## Automatically converting the following non-factors to factors: set_size
pcor_p2_test_err <- Rmisc::summarySEwithin(pcor_p2_test,
                        measurevar = "m",
                        withinvars = c("set_size"),
                        idvar = "ID")
## Automatically converting the following non-factors to factors: set_size
# Continuing to sanity check summarSEwithin 
pcor_p1_test_m <- 
  data.frame(p1_test_trials %>% group_by(set_size) %>% summarize(m=mean(correct)))
pcor_p2_test_m <- 
  data.frame(p2_test_trials %>% group_by(set_size) %>% summarize(m=mean(correct)))
pcor_si6_m <- learn_df %>% filter(stim_iter==6) %>% 
  group_by(set_size) %>% summarize(m=mean(correct))

assert(all(round(pcor_p1_test_err$m, 4)==round(pcor_p1_test_m$m, 4)))
assert(all(round(pcor_p2_test_err$m, 4)==round(pcor_p2_test_m$m, 4)))
assert(all(round(pcor_si6_err$m, 4)==round(pcor_si6_m$m, 4)))

emp_p1_test <- ggplot(pcor_p1_test_err, aes(x=set_size, y=m, fill=set_size)) + 
  geom_hline(yintercept = seq(.1, 1, .1), alpha=.3) +
  geom_bar(stat="identity", color="black") +
  geom_errorbar(aes(ymin=m-se, ymax=m+se), width=.2) + 
  ga + ap + xlab("Set size") + ylab("Proportion correct") + tol + ylim(0, 1) + 
  tp + ggtitle("Test phase 1")

emp_si6 <- ggplot(pcor_si6_err, aes(x=set_size, y=m, fill=set_size)) + 
  geom_hline(yintercept = seq(.1, 1, .1), alpha=.3) +
  geom_bar(stat="identity", color="black") +
  geom_errorbar(aes(ymin=m-se, ymax=m+se), width=.2) + 
  ga + ap + xlab("Set size") + ylab("") + tol + ylim(0, 1) + 
  tp + ggtitle("Stimulus iteration 6")

emp_p2_test <- ggplot(pcor_p2_test_err, aes(x=set_size, y=m, fill=set_size)) + 
  geom_hline(yintercept = seq(.1, 1, .1), alpha=.3) +
  geom_bar(stat="identity", color="black") +
  geom_errorbar(aes(ymin=m-se, ymax=m+se), width=.2) + 
  ga + ap + xlab("Set size") + ylab("") + tol + ylim(0, 1) + tp +
  ggtitle("Test phase 2")

U-shaped pattern evident at test phase 1, which replicates at the beginning of the next learning phase (stimulus iteration 6) before there has been a chance for further learning (thus making it effectively another test trial)

The effect then appears to reduce substantially by test phase 2 — with stim iter 1 still decreased, but set size 2 if anything higher than the others

emps_u_plot <- 
  emp_p1_test + emp_si6 + emp_p2_test + plot_annotation(title="Empirical", theme = theme(plot.title = element_text(size = 25, hjust=.5)))#,
emps_u_plot

Simulation plots

pcor_p1_test_sim_m35 <- 
  data.frame(m35_s_test %>% filter(phase==1) %>% group_by(set_size) %>% summarize(m=mean(corrects)))

pcor_p1_test_sim_m35_iters <- 
  data.frame(m35_s_test %>% filter(phase==1) %>% group_by(set_size, iter) %>% summarize(m=mean(corrects)))
## `summarise()` has grouped output by 'set_size'. You can override using the
## `.groups` argument.
pcor_si6_sim_m35 <- 
  data.frame(m35_s_learn %>% filter(stim_iter==6) %>% group_by(set_size) %>% summarize(m=mean(corrects)))

pcor_si6_sim_m35_iters <- 
  data.frame(m35_s_learn %>% filter(stim_iter==6) %>% group_by(set_size, iter) %>% summarize(m=mean(corrects)))
## `summarise()` has grouped output by 'set_size'. You can override using the
## `.groups` argument.
pcor_p2_test_sim_m35 <- 
  data.frame(m35_s_test %>% filter(phase==2) %>% group_by(set_size) %>% summarize(m=mean(corrects)))

pcor_p2_test_sim_m35_iters <- 
  data.frame(m35_s_test %>% filter(phase==2) %>% group_by(set_size, iter) %>% summarize(m=mean(corrects)))
## `summarise()` has grouped output by 'set_size'. You can override using the
## `.groups` argument.
sim_p1_test_m35 <- 
ggplot(pcor_p1_test_sim_m35, aes(x=as.factor(set_size), y=m, fill=as.factor(set_size))) + 
  geom_hline(yintercept = seq(.1, 1, .1), alpha=.3) +
  geom_bar(stat="identity", color="black") +
  geom_jitter(data=pcor_p1_test_sim_m35_iters, size=2, alpha=1, width=.08, height=0, pch=21,
              aes(x=as.factor(set_size), y=m, fill=as.factor(set_size))) +
  ga + ap + xlab("Set size") + ylab("Proportion correct") + tol + ylim(0, 1) + 
  tp + ggtitle("Test phase 1")

sim_si6_m35 <- ggplot(pcor_si6_sim_m35, aes(x=as.factor(set_size), y=m, fill=as.factor(set_size))) + 
  geom_hline(yintercept = seq(.1, 1, .1), alpha=.3) +
  geom_bar(stat="identity", color="black") +
  geom_jitter(data=pcor_si6_sim_m35_iters, size=2, alpha=1, width=.08, height=0, pch=21,
              aes(x=as.factor(set_size), y=m, fill=as.factor(set_size))) +
  ga + ap + xlab("Set size") + ylab("") + tol + ylim(0, 1) + 
  tp + ggtitle("Stimulus iteration 6")

sim_p2_test_m35 <- ggplot(pcor_p2_test_sim_m35, aes(x=as.factor(set_size), y=m, fill=as.factor(set_size))) + 
  geom_hline(yintercept = seq(.1, 1, .1), alpha=.3) +
  geom_bar(stat="identity", color="black") +
  geom_jitter(data=pcor_p2_test_sim_m35_iters, size=2, alpha=1, width=.08, height=0, pch=21,
              aes(x=as.factor(set_size), y=m, fill=as.factor(set_size))) +
  ga + ap + xlab("Set size") + ylab("") + tol + ylim(0, 1) + tp +
  tp + ggtitle("Test phase 2")
sims_u_plot <- 
  sim_p1_test_m35 + sim_si6_m35 + sim_p2_test_m35 + plot_annotation(title="Simulated", theme = theme(plot.title = element_text(size = 25, hjust=.5)))#,
sims_u_plot

# ggsave("../paper/figs/pieces/fig3_empU.png", emps_u_plot, height = 4, width=11, dpi=300)
#ggsave("../paper/figs/pieces/fig3_simU.png", sims_u_plot, height = 4, width=11, dpi=300)
summary(pcor_p1_test_quad <- 
          glmer(correct ~ poly(set_size, 2)  + 
                        (poly(set_size, 2)|ID), 
                data=test_df %>% filter(phase==1), 
                family="binomial", control = glmerControl(optimizer = "bobyqa")))
## Generalized linear mixed model fit by maximum likelihood (Laplace
##   Approximation) [glmerMod]
##  Family: binomial  ( logit )
## Formula: correct ~ poly(set_size, 2) + (poly(set_size, 2) | ID)
##    Data: test_df %>% filter(phase == 1)
## Control: glmerControl(optimizer = "bobyqa")
## 
##      AIC      BIC   logLik deviance df.resid 
##  18853.1  18922.5  -9417.5  18835.1    16491 
## 
## Scaled residuals: 
##     Min      1Q  Median      3Q     Max 
## -3.9057 -0.8769  0.4293  0.6433  1.9108 
## 
## Random effects:
##  Groups Name               Variance  Std.Dev. Corr       
##  ID     (Intercept)           0.6646  0.8152             
##         poly(set_size, 2)1 1999.3502 44.7141   0.15      
##         poly(set_size, 2)2 2394.8985 48.9377  -0.13 -0.12
## Number of obs: 16500, groups:  ID, 275
## 
## Fixed effects:
##                     Estimate Std. Error z value Pr(>|z|)    
## (Intercept)          0.95321    0.05283  18.043  < 2e-16 ***
## poly(set_size, 2)1  13.42438    3.24378   4.138 3.50e-05 ***
## poly(set_size, 2)2 -26.23676    3.43764  -7.632 2.31e-14 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Correlation of Fixed Effects:
##             (Intr) p(_,2)1
## ply(st_,2)1  0.096        
## ply(st_,2)2 -0.099 -0.065

Predictions look reasonable and do fit a clear inverted U

sjPlot::tab_model(pcor_p1_test_quad)
  correct
Predictors Odds Ratios CI p
(Intercept) 2.59 2.34 – 2.88 <0.001
set size [1st degree] 676291.41 1172.25 – 390163629.22 <0.001
set size [2nd degree] 0.00 0.00 – 0.00 <0.001
Random Effects
σ2 3.29
τ00 ID 0.66
τ11 ID.poly(set_size, 2)1 1999.35
τ11 ID.poly(set_size, 2)2 2394.90
ρ01 0.15
-0.13
ICC 0.22
N ID 275
Observations 16500
Marginal R2 / Conditional R2 0.012 / 0.230 
pcor_p1_test_quad_p <- sjPlot::plot_model(pcor_p1_test_quad, type = "pred", 
                   terms = c("set_size [all]")) + 
  ga + ap + lp + tp + xlab("Set size") + 
  ylab("Proportion correct") + ggtitle("Quadratic model regression predictions \n Phase 1 test")
pcor_p1_test_quad_p

Stimulus iteration 6 replicates effect

summary(pcor_si6_quad <- 
          glmer(correct ~ poly(set_size, 2)  + 
                  (poly(set_size, 2)|ID), 
                data=learn_df %>% filter(stim_iter==6), 
                family="binomial", control = glmerControl(optimizer = "bobyqa")))
## Generalized linear mixed model fit by maximum likelihood (Laplace
##   Approximation) [glmerMod]
##  Family: binomial  ( logit )
## Formula: correct ~ poly(set_size, 2) + (poly(set_size, 2) | ID)
##    Data: learn_df %>% filter(stim_iter == 6)
## Control: glmerControl(optimizer = "bobyqa")
## 
##      AIC      BIC   logLik deviance df.resid 
##   9777.1   9840.3  -4879.6   9759.1     8241 
## 
## Scaled residuals: 
##     Min      1Q  Median      3Q     Max 
## -2.9925 -1.0132  0.4758  0.6605  1.4247 
## 
## Random effects:
##  Groups Name               Variance Std.Dev. Corr       
##  ID     (Intercept)          0.4794  0.6924             
##         poly(set_size, 2)1 414.1219 20.3500   0.28      
##         poly(set_size, 2)2 366.8434 19.1532  -0.48  0.62
## Number of obs: 8250, groups:  ID, 275
## 
## Fixed effects:
##                     Estimate Std. Error z value Pr(>|z|)    
## (Intercept)          0.91428    0.04948  18.478  < 2e-16 ***
## poly(set_size, 2)1   6.44043    2.43970   2.640  0.00829 ** 
## poly(set_size, 2)2 -22.80614    2.48653  -9.172  < 2e-16 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Correlation of Fixed Effects:
##             (Intr) p(_,2)1
## ply(st_,2)1  0.122        
## ply(st_,2)2 -0.237  0.204
pcor_si6_quad_p <- sjPlot::plot_model(pcor_si6_quad, 
                   type = "pred", terms = c("set_size")) + 
  ga + ap + lp + tp + xlab("Set size") + 
  ylab("Proportion correct") + 
  ggtitle("Quadratic model regression predictions \n Stim iter 6")
## Model contains splines or polynomial terms. Consider using
##   `terms="set_size [all]"` to get smooth plots. See also package-vignette
##   'Marginal Effects at Specific Values'.
pcor_si6_quad_p 

sjPlot::tab_model(pcor_si6_quad)
  correct
Predictors Odds Ratios CI p
(Intercept) 2.49 2.26 – 2.75 <0.001
set size [1st degree] 626.67 5.25 – 74768.23 0.008
set size [2nd degree] 0.00 0.00 – 0.00 <0.001
Random Effects
σ2 3.29
τ00 ID 0.48
τ11 ID.poly(set_size, 2)1 414.12
τ11 ID.poly(set_size, 2)2 366.84
ρ01 0.28
-0.48
ICC 0.15
N ID 275
Observations 8250
Marginal R2 / Conditional R2 0.017 / 0.163

Neither linear nor quadratic signif effects

summary(pcor_p2_test_quad <- 
          glmer(correct ~ poly(set_size, 2)  + 
                  (poly(set_size, 2)|ID),
                data=test_df %>% filter(phase==2), 
                family="binomial", control = glmerControl(optimizer = "bobyqa")))
## Generalized linear mixed model fit by maximum likelihood (Laplace
##   Approximation) [glmerMod]
##  Family: binomial  ( logit )
## Formula: correct ~ poly(set_size, 2) + (poly(set_size, 2) | ID)
##    Data: test_df %>% filter(phase == 2)
## Control: glmerControl(optimizer = "bobyqa")
## 
##      AIC      BIC   logLik deviance df.resid 
##  12074.6  12144.0  -6028.3  12056.6    16491 
## 
## Scaled residuals: 
##     Min      1Q  Median      3Q     Max 
## -5.4912  0.1678  0.2476  0.3975  1.4058 
## 
## Random effects:
##  Groups Name               Variance Std.Dev. Corr       
##  ID     (Intercept)           1.513  1.23               
##         poly(set_size, 2)1 3100.386 55.68     0.02      
##         poly(set_size, 2)2 2531.491 50.31     0.06 -0.15
## Number of obs: 16500, groups:  ID, 275
## 
## Fixed effects:
##                    Estimate Std. Error z value Pr(>|z|)    
## (Intercept)          2.3021     0.0814  28.280   <2e-16 ***
## poly(set_size, 2)1  -3.1372     3.4343  -0.913    0.361    
## poly(set_size, 2)2  -4.5952     3.7001  -1.242    0.214    
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Correlation of Fixed Effects:
##             (Intr) p(_,2)1
## ply(st_,2)1 0.010         
## ply(st_,2)2 0.025  0.069
sjPlot::tab_model(pcor_p2_test_quad)
  correct
Predictors Odds Ratios CI p
(Intercept) 10.00 8.52 – 11.72 <0.001
set size [1st degree] 0.04 0.00 – 36.38 0.361
set size [2nd degree] 0.01 0.00 – 14.25 0.214
Random Effects
σ2 3.29
τ00 ID 1.51
τ11 ID.poly(set_size, 2)1 3100.39
τ11 ID.poly(set_size, 2)2 2531.49
ρ01 0.02
0.06
ICC 0.36
N ID 275
Observations 16500
Marginal R2 / Conditional R2 0.000 / 0.361 
pcor_p2_quad_p  <- sjPlot::plot_model(pcor_p2_test_quad, 
                   type = "pred", terms = c("set_size [all]")) + 
  ga + ap + lp + tp + xlab("Set size") + 
  ylab("Proportion correct") + 
  ggtitle("Quadratic model regression \npredictions \n Phase 2 test") 
pcor_p2_quad_p

pcor_p1_test_quad_p + pcor_si6_quad_p +pcor_p2_quad_p 

pcor_p2_quad_p

Using the RL off parameter to capture individual differences in blunting underlying the inverted U

rl_off_p <- 
  ggplot(m35, aes(x=rl_off)) + 
  geom_vline(xintercept=median(m35$rl_off), size=4) +  
  geom_histogram(fill="white", color="black") + ga + ap + ylab("") + 
    ggtitle(TeX('$\\RL^{off}')) + tp + xlab("")
rl_off_p
## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.

#ggsave("../paper/figs/pieces/rl_off.png", rl_off_p, height = 4, width=11, dpi=300)

Dividing up empirically into high vs. low blunters

little_coop <- data.frame(m35 %>% filter(rl_off < median(m35$rl_off)))$ID
high_coop <- data.frame(m35 %>% filter(rl_off > median(m35$rl_off)))$ID
p1_test_emp_trials_m35_lc <- test_df %>% filter(phase==1 & ID %in% little_coop)

pcor_p1_test_emp_m35_lc <- 
  data.frame(p1_test_emp_trials_m35_lc %>% group_by(set_size) %>% summarize(m=mean(correct)))
pcor_p1_test_emp_m35_lc_ID <- 
  data.frame(p1_test_emp_trials_m35_lc %>% group_by(set_size, ID) %>% summarize(m=mean(correct)))
## `summarise()` has grouped output by 'set_size'. You can override using the
## `.groups` argument.
p2_test_emp_trials_m35_lc <- test_df %>% filter(phase==2 & ID %in% little_coop)
pcor_p2_test_emp_m35_lc <- 
  data.frame(p2_test_emp_trials_m35_lc %>% group_by(set_size) %>% summarize(m=mean(correct)))
pcor_p2_test_emp_m35_lc_ID <- 
  data.frame(p2_test_emp_trials_m35_lc %>% group_by(set_size, ID) %>% summarize(m=mean(correct)))
## `summarise()` has grouped output by 'set_size'. You can override using the
## `.groups` argument.
si6_emp_trials_m35_lc <- learn_df %>% filter(stim_iter==6 & ID %in% little_coop)
pcor_si6_m35_lc <- 
  data.frame(si6_emp_trials_m35_lc %>% group_by(set_size) %>% summarize(m=mean(correct)))
pcor_si6_m35_lc_ID <- 
  data.frame(si6_emp_trials_m35_lc %>% group_by(set_size, ID) %>% summarize(m=mean(correct)))
## `summarise()` has grouped output by 'set_size'. You can override using the
## `.groups` argument.
emp_p1_test_m35_lc <- ggplot(pcor_p1_test_emp_m35_lc, aes(x=as.factor(set_size), y=m, fill=as.factor(set_size))) + 
  geom_hline(yintercept = seq(.1, 1, .1), alpha=.3) +
    ga + ap + xlab("Set size") + ylab("Proportion correct") + tol +  ylim(-.022, 1.022) + tp +
    geom_jitter(data=pcor_p1_test_emp_m35_lc_ID, width=.17, height=.02, alpha=.8, aes(color=as.factor(set_size))) + 
    geom_bar(stat="identity", color="black", alpha=.8) +
  tp + ggtitle("Test phase 1")

emp_p2_test_m35_lc <- ggplot(pcor_p2_test_emp_m35_lc, aes(x=as.factor(set_size), y=m, fill=as.factor(set_size))) + 
  geom_hline(yintercept = seq(.1, 1, .1), alpha=.3) +
    ga + ap + xlab("Set size") + ylab("Proportion correct") + tol +  ylim(-.022, 1.022) + tp +
    geom_jitter(data=pcor_p2_test_emp_m35_lc_ID, width=.17, height=.02, alpha=.8, aes(color=as.factor(set_size))) + 
    geom_bar(stat="identity", color="black", alpha=.8) +
  tp + ggtitle("Test phase 2")

emp_si6_lc <- 
  ggplot(pcor_si6_m35_lc, aes(x=as.factor(set_size), y=m, fill=as.factor(set_size))) + 
    geom_hline(yintercept = seq(.1, 1, .1), alpha=.3) +
    ga + ap + xlab("Set size") + ylab("Proportion correct") + tol +  ylim(-.022, 1.022) + tp +
    geom_jitter(data=pcor_si6_m35_lc_ID, width=.17, height=.02, alpha=.8, aes(color=as.factor(set_size))) + 
    geom_bar(stat="identity", color="black", alpha=.8) +
    tp + ggtitle("Stimulus iteration 6")
low_blunt <- emp_p1_test_m35_lc + emp_si6_lc + emp_p2_test_m35_lc

High blunters

p1_test_emp_trials_m35_hc <- test_df %>% filter(phase==1 & ID %in% high_coop)

pcor_p1_test_emp_m35_hc <- 
  data.frame(p1_test_emp_trials_m35_hc %>% group_by(set_size) %>% summarize(m=mean(correct)))
pcor_p1_test_emp_m35_hc_ID <- 
  data.frame(p1_test_emp_trials_m35_hc %>% group_by(set_size, ID) %>% summarize(m=mean(correct)))
## `summarise()` has grouped output by 'set_size'. You can override using the
## `.groups` argument.
p2_test_emp_trials_m35_hc <- test_df %>% filter(phase==2 & ID %in% high_coop)
pcor_p2_test_emp_m35_hc <- 
  data.frame(p2_test_emp_trials_m35_hc %>% group_by(set_size) %>% summarize(m=mean(correct)))
pcor_p2_test_emp_m35_hc_ID <- 
  data.frame(p2_test_emp_trials_m35_hc %>% group_by(set_size, ID) %>% summarize(m=mean(correct)))
## `summarise()` has grouped output by 'set_size'. You can override using the
## `.groups` argument.
si6_emp_trials_m35_hc <- learn_df %>% filter(stim_iter==6 & ID %in% high_coop)
pcor_si6_m35_hc <- 
  data.frame(si6_emp_trials_m35_hc %>% group_by(set_size) %>% summarize(m=mean(correct)))
pcor_si6_m35_hc_ID <- 
  data.frame(si6_emp_trials_m35_hc %>% group_by(set_size, ID) %>% summarize(m=mean(correct)))
## `summarise()` has grouped output by 'set_size'. You can override using the
## `.groups` argument.
emp_p1_test_m35_hc <- ggplot(pcor_p1_test_emp_m35_hc, aes(x=as.factor(set_size), y=m, fill=as.factor(set_size))) + 
  geom_hline(yintercept = seq(.1, 1, .1), alpha=.3) +
    ga + ap + xlab("Set size") + ylab("Proportion correct") + tol +  ylim(-.022, 1.022) + tp +
    geom_jitter(data=pcor_p1_test_emp_m35_hc_ID, width=.17, height=.02, alpha=.8, aes(color=as.factor(set_size))) + 
    geom_bar(stat="identity", color="black", alpha=.8) #+
  #tp + ggtitle("Phase 1")

emp_p2_test_m35_hc <- ggplot(pcor_p2_test_emp_m35_hc, aes(x=as.factor(set_size), y=m, fill=as.factor(set_size))) + 
  geom_hline(yintercept = seq(.1, 1, .1), alpha=.3) +
    ga + ap + xlab("Set size") + ylab("Proportion correct") + tol +  ylim(-.022, 1.022) + tp +
    geom_jitter(data=pcor_p2_test_emp_m35_hc_ID, width=.17, height=.02, alpha=.8, aes(color=as.factor(set_size))) + 
    geom_bar(stat="identity", color="black", alpha=.8) #+
#  tp + ggtitle("Phase 2")

emp_si6_hc <- 
  ggplot(pcor_si6_m35_hc, aes(x=as.factor(set_size), y=m, fill=as.factor(set_size))) + 
    geom_hline(yintercept = seq(.1, 1, .1), alpha=.3) +
    ga + ap + xlab("Set size") + ylab("Proportion correct") + tol +  ylim(-.022, 1.022) + tp +
    geom_jitter(data=pcor_si6_m35_hc_ID, width=.17, height=.02, alpha=.8, aes(color=as.factor(set_size))) + 
    geom_bar(stat="identity", color="black", alpha=.8) #+
    #tp + ggtitle("Stimulus iteration 6")
high_blunt <- emp_p1_test_m35_hc + emp_si6_hc + emp_p2_test_m35_hc
low_vs_high <- low_blunt/high_blunt
low_vs_high

#ggsave("../paper/figs/pieces/fig4_lohiblunt.png", low_vs_high, height = 9, width=11, dpi=300)

Put RL off into the test df

unique_ids <- unique(test_df$ID)

for (i in 1:length(unique_ids)) {
  test_df[test_df$ID==unique_ids[i], "rl_off"] <- m35[m35$ID==unique_ids[i], "rl_off"]
}
# Spot check  
# test_df %>% filter(ID == 24) %>% select(rl_off)
# m35 %>% filter(ID == 24) %>% select(rl_off)
# test_df %>% filter(ID == 85) %>% select(rl_off)
# m35 %>% filter(ID == 85) %>% select(rl_off)
# test_df %>% filter(ID == 2) %>% select(rl_off)
# m35 %>% filter(ID == 2) %>% select(rl_off)
# test_df %>% filter(ID == 219) %>% select(rl_off)
# m35 %>% filter(ID == 219) %>% select(rl_off)
m_rlo <- mean(m35$rl_off)
sd_up <- m_rlo +sd(m35$rl_off) # (.5*sd(m35$rl_off))
sd_down <- m_rlo - sd(m35$rl_off)# (.5*sd(m35$rl_off))

cat("\nMean", m_rlo, "\nOne SD up", sd_up, "\nOne SD down", sd_down)
## 
## Mean 0.544767 
## One SD up 0.8678609 
## One SD down 0.221673
#quantile(m35$rl_off, seq(1/3, 1, 1/3))
#ggsave("../paper/figs/pieces/fig4_mod_rl_off_p.png", mod_rl_off_p, height = 4, width=8, dpi=300)
summary(pcor_p2_moderation <- 
          glmer(correct ~ scale(set_size)*scale(rl_off)  + 
                  (scale(set_size)*scale(rl_off)|ID),
                data=test_df %>% filter(phase==2), 
                family="binomial", control = glmerControl(optimizer = "bobyqa")))
## Generalized linear mixed model fit by maximum likelihood (Laplace
##   Approximation) [glmerMod]
##  Family: binomial  ( logit )
## Formula: correct ~ scale(set_size) * scale(rl_off) + (scale(set_size) *  
##     scale(rl_off) | ID)
##    Data: test_df %>% filter(phase == 2)
## Control: glmerControl(optimizer = "bobyqa")
## 
##      AIC      BIC   logLik deviance df.resid 
##  12009.4  12117.4  -5990.7  11981.4    16486 
## 
## Scaled residuals: 
##     Min      1Q  Median      3Q     Max 
## -8.6425  0.1503  0.2565  0.4166  1.5443 
## 
## Random effects:
##  Groups Name                          Variance Std.Dev. Corr             
##  ID     (Intercept)                   1.20709  1.0987                    
##         scale(set_size)               0.04156  0.2039    0.19            
##         scale(rl_off)                 0.25019  0.5002   -0.34  0.41      
##         scale(set_size):scale(rl_off) 0.06133  0.2476    0.68  0.41  0.41
## Number of obs: 16500, groups:  ID, 275
## 
## Fixed effects:
##                               Estimate Std. Error z value Pr(>|z|)    
## (Intercept)                    2.32737    0.08506  27.362  < 2e-16 ***
## scale(set_size)               -0.03490    0.04117  -0.848    0.397    
## scale(rl_off)                 -0.54108    0.09283  -5.829 5.59e-09 ***
## scale(set_size):scale(rl_off)  0.45056    0.04696   9.594  < 2e-16 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Correlation of Fixed Effects:
##             (Intr) scl(s_) scl(r_)
## scal(st_sz) -0.008                
## scal(rl_ff) -0.306  0.354         
## scl(s_):(_)  0.352 -0.404  -0.038
car::vif(pcor_p2_moderation)
##               scale(set_size)                 scale(rl_off) 
##                      1.384028                      1.160176 
## scale(set_size):scale(rl_off) 
##                      1.212803
mod_rl_off_p <- sjPlot::plot_model(pcor_p2_moderation, type = "pred", 
                   terms = c("set_size [all]", "rl_off [.2217, .5447, .8678]")) +
  ga + ap + lp + tp + xlab("Set size") +
  ylab("") + 
  ggtitle("Moderation of set size effect in final test phase \n by RL blunting") + 
  scale_color_manual(values=c("blue", "gray40", "red"), labels=c("Low", "Medium", "High")) +
  scale_fill_manual(values=c("blue", "gray40", "red"), labels=c("Low", "Medium", "High"))
## Scale for colour is already present.
## Adding another scale for colour, which will replace the existing scale.
mod_rl_off_p

sjPlot::tab_model(pcor_p2_moderation)
  correct
Predictors Odds Ratios CI p
(Intercept) 10.25 8.68 – 12.11 <0.001
set size 0.97 0.89 – 1.05 0.397
rl off 0.58 0.49 – 0.70 <0.001
set size × rl off 1.57 1.43 – 1.72 <0.001
Random Effects
σ2 3.29
τ00 ID 1.21
τ11 ID.scale(set_size) 0.04
τ11 ID.scale(rl_off) 0.25
τ11 ID.scale(set_size):scale(rl_off) 0.06
ρ01 0.19
-0.34
0.68
ICC 0.32
N ID 275
Observations 16500
Marginal R2 / Conditional R2 0.093 / 0.385

Low vs. high low set sizes percents reported in paper

mean(pcor_p1_test_emp_m35_hc[1:3, "m"])
## [1] 0.5612328
mean(pcor_p1_test_emp_m35_lc[1:3, "m"])
## [1] 0.729927
mean(pcor_si6_m35_hc[1:3, "m"])
## [1] 0.5788727
mean(pcor_si6_m35_lc[1:3, "m"])
## [1] 0.7226277
mean(pcor_p2_test_emp_m35_hc[1:3, "m"])
## [1] 0.7650041
mean(pcor_p2_test_emp_m35_lc[1:3, "m"])
## [1] 0.915146

Low vs. high high set sizes

mean(pcor_p1_test_emp_m35_hc[4:5, "m"])
## [1] 0.6972628
mean(pcor_p1_test_emp_m35_lc[4:5, "m"])
## [1] 0.7048814
mean(pcor_si6_m35_hc[4:5, "m"])
## [1] 0.6803832
mean(pcor_si6_m35_lc[4:5, "m"])
## [1] 0.7076642
mean(pcor_p2_test_emp_m35_hc[4:5, "m"])
## [1] 0.8436131
mean(pcor_p2_test_emp_m35_lc[4:5, "m"])
## [1] 0.8611314

Checking low vs. high asymptotic performance — set sizes 1 and 2 are very comparable

lc_asym <- learn_df %>% filter(stim_iter==10 & ID %in% little_coop) %>% group_by(set_size) %>% summarize(m=mean(correct))
hc_asym <- learn_df %>% filter(stim_iter==10 & ID %in% high_coop) %>% group_by(set_size) %>% summarize(m=mean(correct))
mean(unlist(lc_asym[1:3, "m"]))
## [1] 0.9578264
mean(unlist(hc_asym[1:3, "m"]))
## [1] 0.9551906
mean(lc_asym[1:3, "m"])
## Warning in mean.default(lc_asym[1:3, "m"]): argument is not numeric or logical:
## returning NA
## [1] NA

RL off is not much correlated with WM pars

ComparePars(m35$rl_off, m35$phi, use_identity_line = 0)

ComparePars(m35$rl_off, m35$kappa, use_identity_line = 0)

ComparePars(m35$rl_off, m35$rho, use_identity_line = 0)

Incorrect trials

Neutral (over worst) preference at learning and test

A key change in this task from the classic RLWM was having punishment | neutral | reward bandit arms instead of just reward | neutral | neutral. But it’s possible that pts would focus on maximizing reward and not make much distinguish punishment vs. neutral. The below examine neutral > punishment preference during learning and test (retention).

learn_error_df <- learn_df %>% filter(correct==0)

np_summs_m <- learn_error_df %>% group_by(stim_iter) %>% 
  summarize(mw=mean(worst), mn=mean(neutral), n=n()) %>% mutate(neutral_pref=(mn-mw))

# Within-subject adjusted mean and raw don't agree presumably because of amount of 
# variation given sparsity of errors/subject so will just use the raw means for plotting
# so can do accurate compare to model preds  
# np_si <- Rmisc::summarySEwithin(np_summs,
#                         measurevar = "neutral_pref",
#                         withinvars = c("stim_iter"),
#                         idvar = "ID")

# These do disagree before this decimal point   
# round(np_summs_m$neutral_pref, 4)
# round(np_si$neutral_pref, 4)

emp_np_si_plot <- 
  ggplot(np_summs_m, aes(x=stim_iter, y=neutral_pref, fill=as.numeric(stim_iter))) +
       geom_hline(yintercept=.0, size=1.5, color="gray57") + # chance line 
  geom_bar(stat="identity", color="black") + 
  
  #geom_errorbar(aes(ymin=neutral_pref-se, ymax=neutral_pref+se), width=.2) +
    geom_bar(data=np_summs_m,
             aes(x=stim_iter, y=neutral_pref, fill=as.numeric(stim_iter)),
  stat="identity", color="black", alpha=.85) +
  annotate("rect", xmin=5.5, xmax=10.5, ymin=0, ymax=.22, alpha=0.2, fill="gray57") +
  annotate("text", x=3, y=.20, label="Phase 1", size=8) +
  annotate("text", x=7.5, y=.20, label="Phase 2", size=8) +
  ga + ap + tol + xlab("Simulus iteration") + ylab("Neutral preference") + tp + 
  ggtitle("Empirical") + scale_color_gradient2() + ylim(-.1, .23) + scale_x_continuous(breaks = seq(1, 10, by = 1))
emp_np_si_plot

  #move_layers(emp_np_si_plot, "GeomPoint", position = "top")

Capture by sims

np_si_sims_summs <- m35_s %>% 
  filter(type=="learning" & corrects==0) %>% group_by(stim_iter) %>% #filter(stim_iter %in% c(2:10)) %>% 
  summarize(mw=mean(worsts), mn=mean(neutrals), n=n()) %>% mutate(neutral_pref=(mn-mw))

np_si_sims_summs_var <- m35_s %>% 
  filter(type=="learning" & corrects==0) %>%  group_by(stim_iter, iter) %>%  #filter(stim_iter %in% c(2:10)) %>% 
  summarize(mw=mean(worsts), mn=mean(neutrals), n=n()) %>% mutate(neutral_pref=(mn-mw))
## `summarise()` has grouped output by 'stim_iter'. You can override using the
## `.groups` argument.
m35_np_si_plot <- ggplot(np_si_sims_summs, 
                         aes(x=stim_iter, y=neutral_pref, fill=as.numeric(stim_iter))) +
       geom_hline(yintercept=.0, size=1.5, color="gray57") + # chance line 
  
  geom_bar(stat="identity", color="black") +
  geom_jitter(data=np_si_sims_summs_var, aes(x=stim_iter, y=neutral_pref), height=0,
              width=.2, pch=21) +
  annotate("rect", xmin=5.5, xmax=10.5, ymin=0, ymax=.22, alpha=0.2, pch=21) +
  annotate("text", x=3, y=.20, label="Phase 1", size=8) +
  annotate("text", x=7.5, y=.20, label="Phase 2", size=8) +
  ga + ap + tol + xlab("Simulus iteration") + ylab("") + tp + 
  ylim(-.05, .23) +
  ggtitle("Simulated") + scale_color_gradient2() +
  scale_x_continuous(breaks=seq(1, 10, 1)) + ylim(-.1, .23)
## Warning in annotate("rect", xmin = 5.5, xmax = 10.5, ymin = 0, ymax = 0.22, :
## Ignoring unknown parameters: `shape`
## Scale for y is already present.
## Adding another scale for y, which will replace the existing scale.
m35_np_si_plot

Simulation w no punish bonus off

m35_luu <- read.csv("../model_res/sims/SIM_RunRLWMPRewLesionNotPun67064.csv") # Updated non-bug 8-1-24 model  
np_si_sims_summs_luu <- m35_luu  %>% 
  filter(type=="learning" & corrects==0) %>% group_by(stim_iter) %>% 
  summarize(mw=mean(worsts), mn=mean(neutrals), n=n()) %>% mutate(neutral_pref=(mn-mw))

np_si_sims_summs_var_luu <- m35_luu %>% 
  filter(type=="learning" & corrects==0) %>%  group_by(stim_iter, iter) %>% 
  summarize(mw=mean(worsts), mn=mean(neutrals), n=n()) %>% mutate(neutral_pref=(mn-mw))
## `summarise()` has grouped output by 'stim_iter'. You can override using the
## `.groups` argument.
m35_np_si_luu_plot <- 
  ggplot(np_si_sims_summs_luu, 
                         aes(x=stim_iter, y=neutral_pref, fill=as.numeric(stim_iter))) +
       geom_hline(yintercept=.0, size=1.5, color="gray57") + # chance line 
  geom_bar(stat="identity", color="black") + 
  geom_jitter(data=np_si_sims_summs_var_luu, aes(x=stim_iter, y=neutral_pref), pch=21, width=.2) +
  annotate("rect", xmin=5.5, xmax=10.5, ymin=0, ymax=.22, alpha=0.2, fill="gray57") +
  annotate("text", x=3, y=.20, label="Phase 1", size=8) +
  annotate("text", x=7.5, y=.20, label="Phase 2", size=8) +
  ga + ap + tol + xlab("Simulus iteration") + ylab("") + tp + ylim(-.1, .23) +
  ggtitle(TeX("Sim.: Non-pun. bonus = 0")) + scale_color_gradient2()  +
  scale_x_continuous(breaks=seq(1, 10, 1)) + theme(plot.title = element_text(size = 18))
  #theme(plot.title = element_text(vjust = -2.5))

m35_np_si_luu_plot

np_si <- emp_np_si_plot + m35_np_si_plot  + m35_np_si_luu_plot
np_si

#ggsave("../paper/figs/pieces/fig5_neut-pref_emp-and-sims.png", np_si, height = 6, width=12, dpi=300)
# Didn't converge, so do Bayesian version  
# summary(pneut_phase1_le <- glmer(neutral ~ scale(stim_iter) + (0 + scale(stim_iter) |ID), 
#                 data=learn_error_df %>% filter(phase==1), family="binomial", control = glmerControl(optimizer = "bobyqa")))

# Now runnning in brms_s script  
# pneut_time <- brm(
#     neutral ~ scale(stim_iter) + (1 |ID),
#     data = learn_error_df %>% filter(phase==1), 
#     family = bernoulli(link = "logit"), 
#     warmup=2e3, 
#     iter=4e3, 
#     chains=5, 
#     cores=5,
#     control= list(adapt_delta = 0.9))

Note: brms files not shared in public-data due to file size but can be reproduced using brms-s.R

np_p1_brms <- 
  read.csv("../model_res/brms_res/neutral_pref_time_effect_phase1__66703__.csv")
np_p2_brms <- 
  read.csv("../model_res/brms_res/neutral_pref_time_effect_phase2__28768__.csv")
hist(np_p1_brms$b_scalestim_iter, breaks=100)

hist(np_p2_brms$b_scalestim_iter, breaks=100)

length(which(np_p1_brms$b_scalestim_iter < 0))/length(np_p1_brms$b_scalestim_iter)
## [1] 0
length(which(np_p2_brms$b_scalestim_iter < 0))/length(np_p2_brms$b_scalestim_iter)
## [1] 0.0725

Testing effects

test_error_df <- test_df %>% filter(correct==0)

# np_test_summs <- test_error_df %>% group_by(ID, phase) %>% 
#   summarize(mw=mean(worst), mn=mean(neutral), n=n()) %>% mutate(neutral_pref=(mn-mw))

np_test_summs_m <- test_error_df %>% group_by(phase) %>% 
  summarize(mw=mean(worst), mn=mean(neutral), n=n()) %>% mutate(neutral_pref=(mn-mw))


# np_test_si <- Rmisc::summarySEwithin(np_test_summs,
#                         measurevar = "neutral_pref",
#                         withinvars = c("phase"),
#                         idvar = "ID")
# 
# # Within-subject adjusted mean and raw don't agree presumably because of amount of 
# # variation given sparsity of errors/subject so will just use the raw means for plotting
# # so can do accurate compare to model preds  
# np_test_si_sew <- Rmisc::summarySEwithin(np_test_summs,
#                         measurevar = "neutral_pref",
#                         withinvars = c("phase"),
#                         idvar = "ID")
# 
# round(np_test_summs_m$neutral_pref, 4)
# round(np_test_si_sew$neutral_pref, 4)

In contrast to during learning, participants do not appear to retain much ability to avoid the wost stimuli during test

np_test_summs_m
## # A tibble: 2 × 5
##   phase    mw    mn     n neutral_pref
##   <int> <dbl> <dbl> <int>        <dbl>
## 1     1 0.494 0.506  5129       0.0119
## 2     2 0.488 0.512  2458       0.0236
emp_np_si_test_plot <- 
  ggplot(np_test_summs_m, aes(x=as.factor(phase), y=neutral_pref, fill=as.factor(phase))) +
       geom_hline(yintercept=.0, size=1.5, color="gray57") + # chance line 
  geom_bar(stat="identity", color="black") + 
  #geom_errorbar(aes(ymin=neutral_pref-se, ymax=neutral_pref+se), width=.2) + 
  
  ga + ap + tol + xlab("Phase") + ylab("") + tp + 
  ggtitle(#"Neutral preference during test 
    "Empirical") + scale_fill_manual(values=c("gray81", "gray40")) + ylim(-.05, .23)
emp_np_si_test_plot

# ggsave("../paper/figs/pieces/fig6_emp_np_si.png", emp_np_si_test_plot, height = 4, width=5, dpi=300)

And statistically there is no significant ability to pick neutral over worst, or better ability to do so by the second versus first phase.

(These are not singular issue so didn’t need to fit Bayesian model)

summary(pneut_test <- glmer(neutral ~ 1 + (1|ID), 
                data=test_error_df, family="binomial", control = glmerControl(optimizer = "bobyqa")))
## Generalized linear mixed model fit by maximum likelihood (Laplace
##   Approximation) [glmerMod]
##  Family: binomial  ( logit )
## Formula: neutral ~ 1 + (1 | ID)
##    Data: test_error_df
## Control: glmerControl(optimizer = "bobyqa")
## 
##      AIC      BIC   logLik deviance df.resid 
##  10474.7  10488.6  -5235.4  10470.7     7585 
## 
## Scaled residuals: 
##     Min      1Q  Median      3Q     Max 
## -1.4510 -0.9779  0.7725  0.9626  1.3129 
## 
## Random effects:
##  Groups Name        Variance Std.Dev.
##  ID     (Intercept) 0.09459  0.3076  
## Number of obs: 7587, groups:  ID, 275
## 
## Fixed effects:
##             Estimate Std. Error z value Pr(>|z|)
## (Intercept)  0.03924    0.03108   1.263    0.207
summary(pneut_test_phase <- glmer(neutral ~ phase + (phase|ID), 
                data=test_error_df, family="binomial", control = glmerControl(optimizer = "bobyqa")))
## Generalized linear mixed model fit by maximum likelihood (Laplace
##   Approximation) [glmerMod]
##  Family: binomial  ( logit )
## Formula: neutral ~ phase + (phase | ID)
##    Data: test_error_df
## Control: glmerControl(optimizer = "bobyqa")
## 
##      AIC      BIC   logLik deviance df.resid 
##  10477.0  10511.6  -5233.5  10467.0     7582 
## 
## Scaled residuals: 
##     Min      1Q  Median      3Q     Max 
## -1.6292 -0.9788  0.7230  0.9641  1.3537 
## 
## Random effects:
##  Groups Name        Variance Std.Dev. Corr 
##  ID     (Intercept) 0.12691  0.3562        
##         phase       0.06782  0.2604   -0.61
## Number of obs: 7587, groups:  ID, 275
## 
## Fixed effects:
##             Estimate Std. Error z value Pr(>|z|)
## (Intercept) -0.02154    0.07496  -0.287    0.774
## phase        0.04757    0.05488   0.867    0.386
## 
## Correlation of Fixed Effects:
##       (Intr)
## phase -0.910

Bayesian version for more direct comparison to learning where only Bayesian model converged

np_test_brms <- read.csv("../model_res/brms_res/neutral_pref_test_effect__33330__.csv")
hist(np_test_brms$b_Intercept, breaks=100)

length(which(np_test_brms$b_Intercept < 0))/length(np_test_brms$b_Intercept)
## [1] 0.1027

However store the frequentist REs for correlating with test diffs

test_res <- data.frame(ranef(pneut_test)$ID)

The lack of retained ability to avoid punishment over neutral is unsurprising because the RL learning rate from negative PEs fit much lower than that from positive PEs

cat("\nAlpha for pos. PEs quantiles: \n")
## 
## Alpha for pos. PEs quantiles:
round(quantile(m35$alpha_pos), 6)
##       0%      25%      50%      75%     100% 
## 0.000767 0.005559 0.007560 0.010339 0.048076
cat("\nAlpha for neg. PEs quantiles: \n")
## 
## Alpha for neg. PEs quantiles:
round(quantile(m35$alpha_neg), 6)
##       0%      25%      50%      75%     100% 
## 0.000000 0.000000 0.000122 0.002330 0.023870

Take log given strong negative skew

hist(m35$alpha_neg, breaks=100)

hist(log(m35$alpha_neg), breaks=100)

hist(m35$alpha_pos, breaks=100)

hist(log(m35$alpha_pos), breaks=100)

t.test(log(m35$alpha_neg), log(m35$alpha_pos), paired = TRUE)
## 
##  Paired t-test
## 
## data:  log(m35$alpha_neg) and log(m35$alpha_pos)
## t = -16.124, df = 274, p-value < 2.2e-16
## alternative hypothesis: true mean difference is not equal to 0
## 95 percent confidence interval:
##  -7.853473 -6.144423
## sample estimates:
## mean difference 
##       -6.998948
m35_test_sim_error_df <- m35_s_test %>% filter(corrects==0)

np_test_summs_m35_sim <- m35_test_sim_error_df %>% group_by(phase) %>% 
  summarize(mw=mean(worsts), mn=mean(neutrals), n=n()) %>% mutate(neutral_pref=(mn-mw))

np_test_summs_m35_sim_var <- m35_test_sim_error_df %>% group_by(phase, iter) %>% 
  summarize(mw=mean(worsts), mn=mean(neutrals), n=n()) %>% mutate(neutral_pref=(mn-mw))
## `summarise()` has grouped output by 'phase'. You can override using the
## `.groups` argument.

And the model correctly predicts poor retained ability to avoid punishment over neutral overall

sim_m35_np_si_test_plot <- 
  ggplot(np_test_summs_m35_sim , aes(x=as.factor(phase), y=neutral_pref, fill=as.factor(phase))) +
       geom_hline(yintercept=.0, size=1.5, color="gray57") + # chance line
  geom_bar(stat="identity", color="black", alpha=.8) + 
  geom_point(data=np_test_summs_m35_sim_var, aes(x=as.factor(phase), y=neutral_pref, group=iter), 
             size=3, 
             alpha=.8, position=position_dodge(width=.2)) +
  # geom_line(data=np_test_summs_m35_sim_var, 
  #           aes(x=as.factor(phase), y=neutral_pref, color=iter, group=iter),
  #           size=.8, position=position_dodge(width=.2)) +
  #geom_jitter(data=np_test_summs_m35_sim_var, position=position_dodge(width=.2), size=3, alpha=.8) +
  
  #geom_line(data=np_test_summs_m35_sim_var, height=0, width=.2, size=3, alpha=.8, group=phase) +
  
  ga + ap + tol + xlab("Phase") + ylab("") + tp + 
  ggtitle(#"Neutral preference during Test 
          "Simulated") + scale_fill_manual(values=c("gray81", "gray40")) + ylim(-.05, .23)
sim_m35_np_si_test_plot

np_test_summs_m35_sim_var
## # A tibble: 100 × 6
## # Groups:   phase [2]
##    phase  iter    mw    mn     n neutral_pref
##    <int> <int> <dbl> <dbl> <int>        <dbl>
##  1     1     1 0.479 0.521  5219       0.0427
##  2     1     2 0.478 0.522  5234       0.0436
##  3     1     3 0.481 0.519  5296       0.0374
##  4     1     4 0.476 0.524  5279       0.0483
##  5     1     5 0.462 0.538  5392       0.0760
##  6     1     6 0.478 0.522  5170       0.0441
##  7     1     7 0.476 0.524  5234       0.0489
##  8     1     8 0.477 0.523  5381       0.0452
##  9     1     9 0.472 0.528  5296       0.0566
## 10     1    10 0.472 0.528  5337       0.0568
## # ℹ 90 more rows

Whereas a model that sets \(\alpha_{neg} = \alpha_{pos}\) incorrectly predicts a retained neutral preference at a similar level to what is observed empirically at the highest points during learning

m35_s_lesionalphaneg <- 
  read.csv("../model_res/sims/SIM_RunRLWMPRewLesionAlphaNeg27102.csv")
m35_test_sim_error_df_lan <- m35_s_lesionalphaneg %>% filter(corrects==0)

np_test_summs_m35_sim_lan <- m35_test_sim_error_df_lan %>% group_by(phase) %>% 
  summarize(mw=mean(worsts), mn=mean(neutrals), n=n()) %>% mutate(neutral_pref=(mn-mw))

np_test_summs_m35_sim_var_lan <- m35_test_sim_error_df_lan %>% group_by(phase, iter) %>% 
  summarize(mw=mean(worsts), mn=mean(neutrals), n=n()) %>% mutate(neutral_pref=(mn-mw))
## `summarise()` has grouped output by 'phase'. You can override using the
## `.groups` argument.
sim_m35_np_si_test_plot_lan <- 
  ggplot(np_test_summs_m35_sim_lan , aes(x=as.factor(phase), y=neutral_pref, fill=as.factor(phase))) +
       geom_hline(yintercept=.0, size=1.5, color="gray57") + # chance line 
  geom_jitter(data=np_test_summs_m35_sim_var_lan, height=0, width=.2, size=3, alpha=.8) + 
  geom_bar(stat="identity", color="black", alpha=.8) + 
  ga + ap + tol + xlab("Phase") + ylab("") + tp + 
  ggtitle(TeX("Simulated: $\\alpha^{-} = \\alpha^{+}$"))  +
  scale_fill_manual(values=c("gray81", "gray40")) + ylim(-.05, .23)
  #ggtitle("Neutral preference during Test \nSimulated equating TeX('$\\alpha^{-}')") + 
sim_m35_np_si_test_plot_lan

test_np_plots <- 
  emp_np_si_test_plot + sim_m35_np_si_test_plot #+ sim_m35_np_si_test_plot_lan
test_np_plots

ggsave("../paper/figs/pieces/fig6_TEST_neut-pref_emp-and-sims.png", test_np_plots, height = 6, width=12, dpi=300)

Code if alpha pos is greater

m35$alpha_pos_greater <- if_else(m35$alpha_pos > m35$alpha_neg, 1, 0)
table(m35$alpha_pos_greater)
## 
##   0   1 
##  17 258
table(m35$alpha_pos_greater)[2]/sum(table(m35$alpha_pos_greater))
##         1 
## 0.9381818
alpha_comp <- ggplot(m35, 
                     aes(x=alpha_neg, alpha_pos, fill=as.factor(alpha_pos_greater))) + 
    geom_point(size=4, pch=21) + 
    ga + ap + tp + 
    stp + tol + ylim(0, .05) + xlim(0, .05) +
    geom_line(aes(y=alpha_neg)) +
    xlab(TeX("$\\alpha^{-} ")) + 
   ylab(TeX("$\\alpha^{+} ")) + scale_fill_manual(values=c("purple", "orange")) + 
    theme(axis.title = element_text(size=50))
    # ggtitle(model_char, subtitle=str) +
    # ylab(ychar) + xlab(xchar) 
  
alpha_comp

alpha_and_sim <- alpha_comp + sim_m35_np_si_test_plot_lan
# ggsave("../paper/figs/pieces/fig5_alpha_and_sim.png", alpha_and_sim,  height = 6, width=12, dpi=300)

However, there are some individual differences — with those fitting a higher learning from negative PEs showing better ability to retain a neutral preference (and note this correlation is expected to be attenuated due to measurement error due to the relatively poor parameter recovery for the learning rate for negative PEs shown earlier)

hist(m35$alpha_neg)

ComparePars(m35$alpha_neg, test_res$X.Intercept.,
            model_char="", xchar = "Learning rate from negative RPEs", 
            ychar = "Avoidance of punishment \n over neutral at test",
            use_identity_line = 0)

ComparePars(log(m35$alpha_neg), test_res$X.Intercept.,
            model_char="", xchar = "Log (learning rate from negative RPEs)", 
            ychar = "Avoidance of punishment \n over neutral at test",
            use_identity_line = 0)

Individual differences - depression/anxiety and rumination

# qdf %>% filter(catch_q_1 != 1) %>% select(ID)
# qdf %>% filter(catch_q_2 != 1) %>% select(ID)
qdf <- read.csv("../data/questionnaire_df.csv")
demogs <- read.csv("../data/demogs_deident.csv")
if (all(demogs$ID==qdf$ID)) qdf$group <- demogs$group
qdf <- qdf %>% filter(!ID==255)
demogs <- demogs %>% filter(!ID==255)
learn_df <- learn_df %>% filter(!ID==255)
test_df <- test_df %>% filter(!ID==255)

Tiny amount of missing cases so fine to mean impute

length(which(is.na(qdf %>% select(contains("BDI"))))) # 3 missing BDI 
## [1] 3
length(which(is.na(qdf %>% select(contains("GAD"))))) # 4 GAD 
## [1] 4
length(which(is.na(qdf %>% select(contains("RRS"))))) # 3 RRS
## [1] 3
qdf_before_imp <- qdf
for (i in 1:nrow(qdf)) {
  if (any(is.na(qdf[i, grep("BDI", names(qdf))]))) {
    this_row <- qdf[i, grep("BDI", names(qdf))]
    na_idx <- which(is.na(qdf[i, grep("BDI", names(qdf))]))
    this_row[na_idx] <- mean(as.numeric(this_row), na.rm=TRUE)
    qdf[i, grep("BDI", names(qdf))] <- this_row
  }
}

for (i in 1:nrow(qdf)) {
  if (any(is.na(qdf[i, grep("GAD", names(qdf))]))) {
    this_row <- qdf[i, grep("GAD", names(qdf))]
    na_idx <- which(is.na(qdf[i, grep("GAD", names(qdf))]))
    this_row[na_idx] <- mean(as.numeric(this_row), na.rm=TRUE)
    qdf[i, grep("GAD", names(qdf))] <- this_row
  }
}

for (i in 1:nrow(qdf)) {
  if (any(is.na(qdf[i, grep("RRS", names(qdf))]))) {
    this_row <- qdf[i, grep("RRS", names(qdf))]
    na_idx <- which(is.na(qdf[i, grep("RRS", names(qdf))]))
    this_row[na_idx] <- mean(as.numeric(this_row), na.rm=TRUE)
    qdf[i, grep("RRS", names(qdf))] <- this_row
  }
}

Given tiny amount of missing cases so shouldn’t skew values much, doing NA rm for pres

length(which(is.na(qdf %>% select(contains("BDI"))))) # 3 missing BDI 
## [1] 0
length(which(is.na(qdf %>% select(contains("GAD"))))) # 4 GAD 
## [1] 0
length(which(is.na(qdf %>% select(contains("RRS"))))) # 3 RRS
## [1] 0

Sanity check unchanged

# ComparePars(rowSums(qdf[, grep("RRS", names(qdf))]), 
#             rowSums(qdf_before_imp[, grep("RRS", names(qdf_before_imp))]))
# ComparePars(rowSums(qdf[, grep("BDI", names(qdf))]), 
#             rowSums(qdf_before_imp[, grep("BDI", names(qdf_before_imp))]))
# ComparePars(rowSums(qdf[, grep("GAD", names(qdf))]), 
#             rowSums(qdf_before_imp[, grep("GAD", names(qdf_before_imp))]))

Reliability stats

psych::alpha(qdf[, grep("BDI", names(qdf))])
## 
## Reliability analysis   
## Call: psych::alpha(x = qdf[, grep("BDI", names(qdf))])
## 
##   raw_alpha std.alpha G6(smc) average_r S/N    ase mean   sd median_r
##       0.96      0.96    0.97      0.54  25 0.0033 0.68 0.66     0.54
## 
##     95% confidence boundaries 
##          lower alpha upper
## Feldt     0.95  0.96  0.97
## Duhachek  0.95  0.96  0.97
## 
##  Reliability if an item is dropped:
##        raw_alpha std.alpha G6(smc) average_r S/N alpha se  var.r med.r
## BDI.1       0.96      0.96    0.97      0.54  24   0.0034 0.0107  0.54
## BDI.2       0.96      0.96    0.97      0.54  23   0.0035 0.0102  0.54
## BDI.3       0.96      0.96    0.97      0.54  23   0.0036 0.0099  0.54
## BDI.4       0.96      0.96    0.97      0.54  23   0.0035 0.0102  0.54
## BDI.5       0.96      0.96    0.97      0.55  24   0.0034 0.0111  0.55
## BDI.6       0.96      0.96    0.97      0.55  24   0.0034 0.0107  0.55
## BDI.7       0.96      0.96    0.97      0.54  23   0.0036 0.0099  0.54
## BDI.8       0.96      0.96    0.97      0.54  23   0.0036 0.0101  0.54
## BDI.9       0.96      0.96    0.97      0.55  24   0.0034 0.0103  0.54
## BDI.10      0.96      0.96    0.97      0.55  24   0.0034 0.0107  0.56
## BDI.11      0.96      0.96    0.97      0.54  24   0.0034 0.0111  0.55
## BDI.12      0.96      0.96    0.97      0.54  23   0.0036 0.0100  0.54
## BDI.13      0.96      0.96    0.97      0.54  24   0.0035 0.0109  0.54
## BDI.14      0.96      0.96    0.97      0.54  23   0.0036 0.0098  0.54
## BDI.15      0.96      0.96    0.97      0.54  23   0.0035 0.0104  0.54
## BDI.16      0.96      0.96    0.97      0.55  25   0.0033 0.0099  0.56
## BDI.17      0.96      0.96    0.97      0.55  24   0.0034 0.0106  0.55
## BDI.18      0.96      0.96    0.97      0.55  25   0.0033 0.0099  0.56
## BDI.19      0.96      0.96    0.97      0.54  24   0.0034 0.0106  0.54
## BDI.20      0.96      0.96    0.97      0.54  23   0.0035 0.0107  0.54
## BDI.21      0.96      0.96    0.97      0.55  25   0.0033 0.0096  0.56
## 
##  Item statistics 
##          n raw.r std.r r.cor r.drop mean   sd
## BDI.1  275  0.73  0.74  0.72   0.71 0.56 0.80
## BDI.2  275  0.80  0.79  0.78   0.77 0.85 0.95
## BDI.3  275  0.84  0.83  0.83   0.81 0.93 1.03
## BDI.4  275  0.84  0.84  0.83   0.82 0.71 0.84
## BDI.5  275  0.73  0.73  0.71   0.70 0.60 0.77
## BDI.6  275  0.72  0.72  0.70   0.69 0.56 0.95
## BDI.7  275  0.84  0.83  0.83   0.81 0.88 1.07
## BDI.8  275  0.84  0.83  0.83   0.81 0.76 0.94
## BDI.9  275  0.70  0.70  0.69   0.67 0.37 0.66
## BDI.10 275  0.68  0.68  0.65   0.64 0.47 0.89
## BDI.11 275  0.73  0.74  0.73   0.71 0.56 0.74
## BDI.12 275  0.85  0.85  0.85   0.83 0.78 0.90
## BDI.13 275  0.78  0.78  0.77   0.76 0.52 0.85
## BDI.14 275  0.83  0.83  0.83   0.81 0.75 1.02
## BDI.15 275  0.80  0.80  0.79   0.77 0.89 0.92
## BDI.16 275  0.62  0.62  0.59   0.58 0.88 0.94
## BDI.17 275  0.70  0.71  0.69   0.67 0.51 0.75
## BDI.18 275  0.61  0.62  0.59   0.57 0.53 0.80
## BDI.19 275  0.74  0.74  0.73   0.71 0.65 0.84
## BDI.20 275  0.81  0.81  0.81   0.79 0.79 0.90
## BDI.21 275  0.61  0.61  0.58   0.57 0.64 0.93
## 
## Non missing response frequency for each item
##           0 0.5    1 1.05 1.35    2    3 miss
## BDI.1  0.58   0 0.32    0    0 0.05 0.05    0
## BDI.2  0.45   0 0.34    0    0 0.13 0.08    0
## BDI.3  0.46   0 0.26    0    0 0.17 0.11    0
## BDI.4  0.51   0 0.30    0    0 0.16 0.03    0
## BDI.5  0.56   0 0.32    0    0 0.10 0.03    0
## BDI.6  0.68   0 0.17    0    0 0.07 0.09    0
## BDI.7  0.52   0 0.21    0    0 0.16 0.12    0
## BDI.8  0.53   0 0.24    0    0 0.17 0.06    0
## BDI.9  0.71   0 0.24    0    0 0.03 0.02    0
## BDI.10 0.72   0 0.17    0    0 0.03 0.08    0
## BDI.11 0.57   0 0.32    0    0 0.09 0.02    0
## BDI.12 0.48   0 0.30    0    0 0.16 0.05    0
## BDI.13 0.65   0 0.23    0    0 0.06 0.06    0
## BDI.14 0.58   0 0.19    0    0 0.13 0.10    0
## BDI.15 0.42   0 0.32    0    0 0.19 0.06    0
## BDI.16 0.43   0 0.32    0    0 0.17 0.07    0
## BDI.17 0.61   0 0.28    0    0 0.08 0.03    0
## BDI.18 0.63   0 0.25    0    0 0.08 0.04    0
## BDI.19 0.56   0 0.27    0    0 0.14 0.03    0
## BDI.20 0.47   0 0.33    0    0 0.13 0.06    0
## BDI.21 0.61   0 0.20    0    0 0.12 0.07    0
psych::alpha(qdf[, grep("GAD", names(qdf))])
## 
## Reliability analysis   
## Call: psych::alpha(x = qdf[, grep("GAD", names(qdf))])
## 
##   raw_alpha std.alpha G6(smc) average_r S/N    ase mean   sd median_r
##       0.94      0.94    0.94      0.67  15 0.0058 0.84 0.83     0.66
## 
##     95% confidence boundaries 
##          lower alpha upper
## Feldt     0.92  0.94  0.95
## Duhachek  0.92  0.94  0.95
## 
##  Reliability if an item is dropped:
##       raw_alpha std.alpha G6(smc) average_r S/N alpha se  var.r med.r
## GAD_1      0.92      0.92    0.92      0.66  11   0.0074 0.0074  0.65
## GAD_2      0.92      0.92    0.91      0.66  11   0.0074 0.0059  0.65
## GAD_3      0.92      0.92    0.91      0.65  11   0.0075 0.0054  0.62
## GAD_4      0.93      0.93    0.92      0.67  12   0.0068 0.0110  0.62
## GAD_5      0.93      0.93    0.93      0.70  14   0.0060 0.0081  0.71
## GAD_6      0.93      0.93    0.93      0.70  14   0.0060 0.0084  0.71
## GAD_7      0.93      0.93    0.93      0.68  13   0.0067 0.0100  0.66
## 
##  Item statistics 
##         n raw.r std.r r.cor r.drop mean   sd
## GAD_1 275  0.90  0.89  0.88   0.86 1.01 0.99
## GAD_2 275  0.90  0.89  0.89   0.86 0.87 1.02
## GAD_3 275  0.91  0.90  0.91   0.87 0.99 1.05
## GAD_4 275  0.85  0.85  0.82   0.80 0.95 1.00
## GAD_5 275  0.77  0.78  0.73   0.70 0.51 0.88
## GAD_6 275  0.78  0.78  0.72   0.70 0.83 0.93
## GAD_7 275  0.84  0.84  0.80   0.78 0.71 0.93
## 
## Non missing response frequency for each item
##          0    1 1.66666666666667    2    3 miss
## GAD_1 0.37 0.36                0 0.16 0.11    0
## GAD_2 0.47 0.30                0 0.11 0.12    0
## GAD_3 0.43 0.29                0 0.16 0.13    0
## GAD_4 0.41 0.33                0 0.14 0.11    0
## GAD_5 0.69 0.16                0 0.09 0.06    0
## GAD_6 0.45 0.33                0 0.13 0.08    0
## GAD_7 0.55 0.28                0 0.11 0.07    0
psych::alpha(qdf[, grep("RRS", names(qdf))])
## 
## Reliability analysis   
## Call: psych::alpha(x = qdf[, grep("RRS", names(qdf))])
## 
##   raw_alpha std.alpha G6(smc) average_r S/N    ase mean   sd median_r
##        0.9       0.9    0.92      0.46 8.6 0.0088    2 0.71     0.48
## 
##     95% confidence boundaries 
##          lower alpha upper
## Feldt     0.88   0.9  0.92
## Duhachek  0.88   0.9  0.92
## 
##  Reliability if an item is dropped:
##        raw_alpha std.alpha G6(smc) average_r S/N alpha se var.r med.r
## RRS_1       0.89      0.89    0.91      0.47 8.1   0.0093 0.029  0.50
## RRS_2       0.88      0.88    0.90      0.45 7.2   0.0101 0.029  0.44
## RRS_3       0.88      0.88    0.90      0.45 7.4   0.0101 0.028  0.44
## RRS_4       0.89      0.88    0.90      0.45 7.5   0.0098 0.028  0.48
## RRS_5       0.91      0.91    0.92      0.52 9.7   0.0085 0.014  0.51
## RRS_6       0.89      0.89    0.91      0.46 7.7   0.0097 0.028  0.47
## RRS_7       0.88      0.88    0.90      0.45 7.4   0.0101 0.026  0.47
## RRS_8       0.89      0.88    0.90      0.45 7.5   0.0100 0.026  0.46
## RRS_9       0.88      0.88    0.90      0.44 7.2   0.0103 0.029  0.44
## RRS_10      0.89      0.89    0.90      0.46 7.8   0.0094 0.030  0.49
## 
##  Item statistics 
##          n raw.r std.r r.cor r.drop mean   sd
## RRS_1  275  0.67  0.66  0.62   0.58  1.8 0.94
## RRS_2  275  0.79  0.80  0.78   0.73  2.2 0.98
## RRS_3  275  0.78  0.77  0.75   0.72  2.0 0.98
## RRS_4  275  0.75  0.76  0.75   0.68  2.2 0.95
## RRS_5  275  0.39  0.43  0.33   0.30  1.4 0.70
## RRS_6  275  0.72  0.71  0.67   0.64  2.4 1.02
## RRS_7  275  0.79  0.77  0.76   0.72  2.0 1.07
## RRS_8  275  0.78  0.76  0.74   0.70  2.1 1.08
## RRS_9  275  0.81  0.81  0.79   0.75  2.0 1.03
## RRS_10 275  0.69  0.71  0.68   0.61  2.2 0.96
## 
## Non missing response frequency for each item
##           1 1.33333333333333    2 2.22222222222222    3    4 miss
## RRS_1  0.51                0 0.30                0 0.11 0.08    0
## RRS_2  0.27                0 0.37                0 0.24 0.12    0
## RRS_3  0.40                0 0.32                0 0.19 0.09    0
## RRS_4  0.28                0 0.40                0 0.22 0.11    0
## RRS_5  0.67                0 0.27                0 0.04 0.03    0
## RRS_6  0.21                0 0.35                0 0.25 0.19    0
## RRS_7  0.44                0 0.27                0 0.15 0.14    0
## RRS_8  0.40                0 0.27                0 0.19 0.15    0
## RRS_9  0.40                0 0.29                0 0.18 0.12    0
## RRS_10 0.28                0 0.36                0 0.25 0.11    0

Sum scores

qdf$BDI_sum <- rowSums(qdf[, grep("BDI", names(qdf))])
qdf$GAD_sum <- rowSums(qdf[, grep("GAD", names(qdf))])
qdf$RRS_sum <- rowSums(qdf[, grep("RRS", names(qdf))])
#qdf$depr_anx_norm_sum <- qdf$BDI_sum + qdf$GAD_sum

qdf$depr_anx_norm_sum <- (scale(qdf$BDI_sum) + scale(qdf$GAD_sum))/2 # Corrected sum of normalized vals for revision 4/18/25 
hist(qdf$depr_anx_norm_sum, breaks=100)

#any(is.na(qdf))
#write.csv(qdf, "../data/questionnaire_df_with_impute.csv")

Put depr/anxisety sum and GAD sum into learn df

unique_ids <- unique(learn_df$ID)
for (i in 1:length(unique_ids)) {
  
  learn_df[learn_df$ID==unique_ids[i], "depr_anx_norm_sum"] <-
    as.numeric(qdf[qdf$ID==unique_ids[i], "depr_anx_norm_sum"])
  learn_df[learn_df$ID==unique_ids[i], "bdi_sum"] <- qdf[qdf$ID==unique_ids[i], "BDI_sum"]
  learn_df[learn_df$ID==unique_ids[i], "gad_sum"] <- qdf[qdf$ID==unique_ids[i], "GAD_sum"]
  learn_df[learn_df$ID==unique_ids[i], "rrs_sum"] <- qdf[qdf$ID==unique_ids[i], "RRS_sum"]
  
  test_df[test_df$ID==unique_ids[i], "depr_anx_norm_sum"] <-
    as.numeric(qdf[qdf$ID==unique_ids[i], "depr_anx_norm_sum"])
  test_df[test_df$ID==unique_ids[i], "bdi_sum"] <- qdf[qdf$ID==unique_ids[i], "BDI_sum"]
  test_df[test_df$ID==unique_ids[i], "gad_sum"] <- qdf[qdf$ID==unique_ids[i], "GAD_sum"]
  test_df[test_df$ID==unique_ids[i], "rrs_sum"] <- qdf[qdf$ID==unique_ids[i], "RRS_sum"]
}
# Check 
# hist(learn_df$depr_anx_norm_sum)
# hist(test_df$depr_anx_norm_sum)

hist(learn_df$depr_anx_norm_sum)

hist(test_df$depr_anx_norm_sum)

# 
# hist(learn_df$rrs_sum)
# hist(test_df$rrs_sum)
# Export — df imported into for brms_s 
# write.csv(learn_df, "../data/learn_df_with_qairre_data.csv")
# write.csv(test_df, "../data/test_df_with_qairre_data.csv")

Plot for supp fig

bdi_means <- qdf %>% group_by(group) %>% summarize(m=mean(BDI_sum))
bdi_p <- ggplot(qdf, aes(x=BDI_sum, fill=group, color=group)) + 
  geom_vline(data=bdi_means, aes(xintercept = m, color=group), size=3) +
  geom_density(alpha=.4, linewidth=3) + ga + ap + lp + ylab("") + 
  xlab("") + 
  theme(axis.text.y = element_blank()) + 
  theme(axis.ticks.y = element_blank()) + 
  scale_fill_manual(values=c("red", "blue", "gray")) +
  scale_color_manual(values=c("red", "blue", "gray")) + 
  ggtitle("Depression (BDI-II)") + tp + 
  tol

Just for legend

# ggplot(qdf, aes(x=BDI_sum, fill=group, color=group)) +
#   geom_density(alpha=.4, linewidth=3) + ga + ap + lp + ylab("") +
#   xlab("") +
#   theme(axis.text.y = element_blank()) +
#   theme(axis.ticks.y = element_blank()) +
#   scale_fill_manual(values=c("red", "blue", "gray")) +
#   scale_color_manual(values=c("red", "blue", "gray")) +
#   ggtitle("Depression (BDI-II)") + tp
gad_means <- qdf %>% group_by(group) %>% summarize(m=mean(GAD_sum))

gad_p <- ggplot(qdf, aes(x=GAD_sum, fill=group, color=group)) + 
  geom_vline(data=gad_means, aes(xintercept = m, color=group), size=3) +
  geom_density(alpha=.4, linewidth=3) + ga + ap + lp + ylab("") + 
  xlab("") + 
  theme(axis.text.y = element_blank()) + 
  theme(axis.ticks.y = element_blank()) + 
  scale_fill_manual(values=c("red", "blue", "gray")) +
  scale_color_manual(values=c("red", "blue", "gray")) + 
  ggtitle("Generalized anxiety (GAD-7)") + tp + 
  tol
rrs_means <- qdf %>% group_by(group) %>% summarize(m=mean(RRS_sum))

rrs_p <- ggplot(qdf, aes(x=RRS_sum, fill=group, color=group)) + 
  geom_vline(data=rrs_means, aes(xintercept = m, color=group), size=3) +
  geom_density(alpha=.4, linewidth=3) + ga + ap + lp + ylab("") + 
  xlab("") + 
  theme(axis.text.y = element_blank()) + 
  theme(axis.ticks.y = element_blank()) + 
  scale_fill_manual(values=c("red", "blue", "gray")) +
  scale_color_manual(values=c("red", "blue", "gray")) + 
  ggtitle("Rumination (RRS-SF)") + tp + 
  tol
sum(table(qdf$group))
## [1] 275
sym_plot <- bdi_p/ gad_p / rrs_p
sym_plot

#ggsave("../paper/figs/supp-figs/symptom_plot.png", sym_plot, width=8.5, height = 8.5, dpi=200)

Behavioral performance and individual differences

cor.test(learn_m$m, qdf$depr_anx_norm_sum)
## 
##  Pearson's product-moment correlation
## 
## data:  learn_m$m and qdf$depr_anx_norm_sum
## t = -0.092171, df = 273, p-value = 0.9266
## alternative hypothesis: true correlation is not equal to 0
## 95 percent confidence interval:
##  -0.1237806  0.1127800
## sample estimates:
##          cor 
## -0.005578353
cor.test(test_m$m, qdf$depr_anx_norm_sum)
## 
##  Pearson's product-moment correlation
## 
## data:  test_m$m and qdf$depr_anx_norm_sum
## t = 0.1196, df = 273, p-value = 0.9049
## alternative hypothesis: true correlation is not equal to 0
## 95 percent confidence interval:
##  -0.1111411  0.1254146
## sample estimates:
##         cor 
## 0.007238031
cor.test(learn_m$m, qdf$RRS_sum)
## 
##  Pearson's product-moment correlation
## 
## data:  learn_m$m and qdf$RRS_sum
## t = -0.023301, df = 273, p-value = 0.9814
## alternative hypothesis: true correlation is not equal to 0
## 95 percent confidence interval:
##  -0.1196743  0.1168932
## sample estimates:
##          cor 
## -0.001410259
cor.test(test_m$m, qdf$RRS_sum)
## 
##  Pearson's product-moment correlation
## 
## data:  test_m$m and qdf$RRS_sum
## t = 0.0072235, df = 273, p-value = 0.9942
## alternative hypothesis: true correlation is not equal to 0
## 95 percent confidence interval:
##  -0.1178529  0.1187150
## sample estimates:
##          cor 
## 0.0004371846
ctest <- cor.test(qdf$GAD_sum, qdf$BDI_sum)
r <- round(ctest$estimate, 2)
p <- round(ctest$p.value, 2)
str <- paste("r =", r, "p =", p)
  
  
ggplot(qdf, aes(x=GAD_sum, BDI_sum)) + 
    geom_smooth(method='lm', formula= y~x, color="black", size=3) +
    geom_point(size=6, fill="white", pch=21) + 
    ga + ap + tp + 
    ggtitle("", subtitle=str) +
    ylab("BDI-II") + xlab("GAD-7") + 
    theme(plot.subtitle = element_text(size = 25, face = "bold"))

Create high low DA, BDI and GAD

median(qdf$BDI_sum)
## [1] 10
median(qdf$GAD_sum)
## [1] 4
hist(qdf$depr_anx_norm_sum, breaks=100)

median(qdf$depr_anx_norm_sum)
## [1] -0.2609082
table(if_else(qdf$depr_anx_norm_sum > median(qdf$depr_anx_norm_sum), 1, 0))
## 
##   0   1 
## 139 136
#table(if_else(qdf$depr_anx_norm_sum > median(qdf$depr_anx_norm_sum), 1, 0)) # Check that's about half
qdf$DA_hilo <- if_else(qdf$depr_anx_norm_sum > median(qdf$depr_anx_norm_sum), 1, 0)
qdf %>% group_by(DA_hilo) %>% summarize(m=median(depr_anx_norm_sum)) # Confirm
## # A tibble: 2 × 2
##   DA_hilo      m
##     <dbl>  <dbl>
## 1       0 -0.807
## 2       1  0.545
#table(if_else(qdf$depr_anx_norm_sum > median(qdf$depr_anx_norm_sum), 1, 0))
qdf$dep_hilo <- if_else(qdf$BDI_sum > median(qdf$BDI_sum), 1, 0)
#qdf %>% group_by(dep_hilo) %>% summarize(m=median(depr_anx_norm_sum)) 
#table(if_else(qdf$GAD_sum > median(qdf$GAD_sum), 1, 0))
qdf$anx_hilo <- if_else(qdf$GAD_sum > median(qdf$GAD_sum), 1, 0)
#qdf %>% group_by(anx_hilo) %>% summarize(m=median(GAD_sum)) 
table(if_else(qdf$RRS_sum > median(qdf$RRS_sum), 1, 0))
## 
##   0   1 
## 146 129
qdf$rrs_hilo <- if_else(qdf$RRS_sum > median(qdf$RRS_sum), 1, 0) 
qdf %>% group_by(rrs_hilo) %>% summarize(m=median(RRS_sum)) 
## # A tibble: 2 × 2
##   rrs_hilo     m
##      <dbl> <dbl>
## 1        0    15
## 2        1    25

Put into learning and test dfs

high_depr_anx_pts <- qdf[qdf$DA_hilo == 1, "ID"]
low_depr_anx_pts <- qdf[qdf$DA_hilo == 0, "ID"]

learn_df[learn_df$ID %in% high_depr_anx_pts, "DA_hilo"] <- "high depr-anx"
learn_df[learn_df$ID %in% low_depr_anx_pts, "DA_hilo"] <- "low depr-anx"

test_df[test_df$ID %in% high_depr_anx_pts, "DA_hilo"] <- "high depr-anx"
test_df[test_df$ID %in% low_depr_anx_pts, "DA_hilo"] <- "low depr-anx"
high_rum_pts <- qdf[qdf$rrs_hilo == 1, "ID"]
low_rum_pts <- qdf[qdf$rrs_hilo == 0, "ID"]

learn_df[learn_df$ID %in% high_rum_pts, "rrs_hilo"] <- "high rum"
learn_df[learn_df$ID %in% low_rum_pts, "rrs_hilo"] <- "low rum"

test_df[test_df$ID %in% high_rum_pts, "rrs_hilo"] <- "high rum"
test_df[test_df$ID %in% low_rum_pts, "rrs_hilo"] <- "low rum"

Plot proportion correct by median split

pcor_ss_DA <- data.frame(learn_df %>% group_by(stim_iter, set_size, 
                                            ID, DA_hilo) %>% summarize(m=mean(correct)))
## `summarise()` has grouped output by 'stim_iter', 'set_size', 'ID'. You can
## override using the `.groups` argument.
pcor_ss_err_DA <- Rmisc::summarySEwithin(pcor_ss_DA,
                        measurevar = "m",
                        withinvars = c("set_size", "stim_iter", "DA_hilo"),
                        idvar = "ID")
## Automatically converting the following non-factors to factors: set_size, stim_iter, DA_hilo
pcor_ss_err_DA$DA_hilo <- factor(pcor_ss_err_DA$DA_hilo, levels=c("low depr-anx", "high depr-anx"))
pcor_by_grp <- ggplot(pcor_ss_err_DA, aes(x=stim_iter, y=m, group=as.factor(DA_hilo), 
                                  color=as.factor(DA_hilo))) + 
  geom_line() + 
  geom_ribbon(aes(ymin=m-se, ymax=m+se), fill='gray57', alpha=.45) + 
          geom_hline(yintercept=.33, size=1.5, color="gray57") + # chance line 
          geom_hline(yintercept=c(.5, .6, .7, .8, .9, 1), linetype="dotted") +
  geom_point(aes(fill=as.factor(DA_hilo)), color="black", size=5, pch=21) + 
          geom_vline(xintercept=c(2, 5, 8, 10), linetype="dotted") +
          #geom_point(aes(fill=as.factor(set_size)), color="black", size=5, pch=21) + 
  annotate("rect", xmin=6, xmax=10.5, ymin=.3, ymax=1.1, alpha=0.2, fill="gray57") +
  ga + ap + lp + xlab("Stimulus iteration") + ylab("Proportion correct") + 
  ggtitle("") + tp + facet_wrap(~ set_size) + ft + lp + 
  scale_fill_manual(values=c("orange1", "brown")) + 
  scale_color_manual(values=c("orange1", "brown")) + tol
pcor_by_grp 

#ggsave("../paper/figs/pieces/pcor_by_grp.png", pcor_by_grp, width=14, height=10, dpi=300)
pcor_ss_rrs <- data.frame(learn_df %>% group_by(stim_iter, set_size, 
                                            ID, rrs_hilo) %>% summarize(m=mean(correct)))
## `summarise()` has grouped output by 'stim_iter', 'set_size', 'ID'. You can
## override using the `.groups` argument.
pcor_ss_err_rrs <- Rmisc::summarySEwithin(pcor_ss_rrs,
                        measurevar = "m",
                        withinvars = c("set_size", "stim_iter", "rrs_hilo"),
                        idvar = "ID")
## Automatically converting the following non-factors to factors: set_size, stim_iter, rrs_hilo
pcor_ss_err_rrs$rrs_hilo <- factor(pcor_ss_err_rrs$rrs_hilo, levels=c("low rum", "high rum"))
pcor_by_grp_rum <- ggplot(pcor_ss_err_rrs, aes(x=stim_iter, y=m, group=as.factor(rrs_hilo), 
                                  color=as.factor(rrs_hilo))) + 
  geom_line() + 
  geom_ribbon(aes(ymin=m-se, ymax=m+se), fill='gray57', alpha=.45) + 
          geom_hline(yintercept=.33, size=1.5, color="gray57") + # chance line 
          geom_hline(yintercept=c(.5, .6, .7, .8, .9, 1), linetype="dotted") +
  geom_point(aes(fill=as.factor(rrs_hilo)), color="black", size=5, pch=21) + 
          geom_vline(xintercept=c(2, 5, 8, 10), linetype="dotted") +
          #geom_point(aes(fill=as.factor(set_size)), color="black", size=5, pch=21) + 
  annotate("rect", xmin=6, xmax=10.5, ymin=.3, ymax=1.1, alpha=0.2, fill="gray57") +
  ga + ap + lp + xlab("Stimulus iteration") + ylab("Proportion correct") + 
  ggtitle("") + tp + facet_wrap(~ set_size) + ft + lp + 
  scale_fill_manual(values=c("red", "darkred")) + 
  scale_color_manual(values=c("red", "darkred"))

Rumination version

pcor_by_grp_rum

#ggsave("../paper/figs/pieces/pcor_by_grp_rum.png", pcor_by_grp_rum, width=14, height=8, dpi=300)
test_error_df <- test_df %>% filter(correct==0)

np_test_summs_da <- test_error_df %>% group_by(ID, DA_hilo, phase) %>% 
  summarize(mw=mean(worst), mn=mean(neutral), n=n()) %>% mutate(neutral_pref=(mn-mw))
## `summarise()` has grouped output by 'ID', 'DA_hilo'. You can override using the
## `.groups` argument.
np_test_si_da <- Rmisc::summarySEwithin(np_test_summs_da,
                        measurevar = "neutral_pref",
                        withinvars = c("DA_hilo", "phase"),
                        idvar = "ID")
## Automatically converting the following non-factors to factors: DA_hilo, phase
np_test_si_da$DA_hilo <- factor(np_test_si_da$DA_hilo, levels=c("low depr-anx", "high depr-anx"))
ggplot(np_test_si_da, aes(x=phase, y=neutral_pref, fill=phase)) +
       geom_hline(yintercept=.0, size=1.5, color="gray57") + # chance line 
  geom_bar(stat="identity", color="black") + 
  geom_errorbar(aes(ymin=neutral_pref-se, ymax=neutral_pref+se), width=.2) + 
  
  ga + ap + tol + xlab("Phase") + ylab("") + tp + 
  ggtitle(#"Neutral preference during test 
    "Empirical") + scale_fill_manual(values=c("gray81", "gray40")) + ylim(-.05, .23) + facet_wrap(~ DA_hilo)  + ft

Read in BRMS posteriors fit with brms_s.R for behavior

Performace in terms of proprortion correct

# phase1_learn_perf <- read.csv("../model_res/brms_res/reduced_perf_model_phase1__86050__.csv")
# 
# phase2_learn_perf <- read.csv("../model_res/brms_res/reduced_correct_perf_model_phase2__76459__.csv")
# 
# test_perf <- read.csv("../model_res/brms_res/reduced_correct_test_model__24237__.csv")

# Replacement sum score 4/21/25 reviewer 3 
phase1_learn_perf <- read.csv("../model_res/brms_res/reduced_perf_model_phase1__75567__.csv")

phase2_learn_perf <- read.csv("../model_res/brms_res/reduced_correct_perf_model_phase2__14248__.csv")

test_perf <- read.csv("../model_res/brms_res/reduced_correct_test_model__89989__.csv")
ReturnPosteriorMeanAnd90CI <- function(posterior) {
  cat("\nposterior mean =", mean(posterior))
  cat("\n90% CI ="); print (bayestestR::ci(posterior, ci = .9, method = "HDI"))
}

Neutral preference

np_da <- read.csv("../model_res/brms_res/neutral_pref_learn_model__30606__.csv")
# Version that converged that has intercept set to 0 but models REs in depr/anx  
np_test_da <- read.csv("../model_res/brms_res/neutral_pref_test_model_0int__18974__.csv")

Rumination

phase1_rum <- read.csv("../model_res/brms_res/RUM_reduced_perf_model_phase1__63279__.csv")
phase2_rum <- read.csv("../model_res/brms_res/RUM_reduced_correct_perf_model_phase2__25543__.csv")
test_rum <- read.csv("../model_res/brms_res/RUM_reduced_correct_test_model__53350__.csv")
np_rum <- read.csv("../model_res/brms_res/RUM_neutral_pref_learn_model__89767__.csv")
np_test_rum <- read.csv("../model_res/brms_res/RUM_neutral_pref_test_model__71650__.csv")

Proportion correct ~ symptoms

Phase 1

#phase1_learn_perf$b_scaledepr_anx_norm_sum.scaleset_size
cat("\n Depression prop correct phase 1: \n")
## 
##  Depression prop correct phase 1:
# DA  
#ReturnPosteriorMeanAnd90CI(phase1_learn_perf$b_scaledepr_anx_norm_sum)
ReturnPosteriorMeanAnd90CI(phase1_learn_perf$b_scaledepr_anx_norm_sum)
## 
## posterior mean = -0.00622367
## 90% CI =90% HDI: [-0.04, 0.03]
ReturnPosteriorMeanAnd90CI(phase1_learn_perf$b_scaleset_size) # Sanity check this is negative and tight  
## 
## posterior mean = -0.3167938
## 90% CI =90% HDI: [-0.34, -0.30]
#ReturnPosteriorMeanAnd90CI(phase1_learn_perf$b_scaledepr_anx_norm_sum.scaleset_size)
ReturnPosteriorMeanAnd90CI(phase1_learn_perf$b_scaledepr_anx_norm_sum.scaleset_size)
## 
## posterior mean = 0.005772841
## 90% CI =90% HDI: [-0.01, 0.02]
cat("\n\n Rumination prop correct phase 1: \n")
## 
## 
##  Rumination prop correct phase 1:
# Rum 
ReturnPosteriorMeanAnd90CI(phase1_rum$b_scalerrs_sum)
## 
## posterior mean = -0.007088953
## 90% CI =90% HDI: [-0.04, 0.03]
ReturnPosteriorMeanAnd90CI(phase1_rum$b_scaleset_size) # Sanity check - v consistent with above  
## 
## posterior mean = -0.3169965
## 90% CI =90% HDI: [-0.33, -0.30]
ReturnPosteriorMeanAnd90CI(phase1_rum$b_scalerrs_sum.scaleset_size)
## 
## posterior mean = 0.01584776
## 90% CI =90% HDI: [ 0.00, 0.03]

Phase 2

# DA  
cat("\n\n Depression prop correct phase 2: \n")
## 
## 
##  Depression prop correct phase 2:
#ReturnPosteriorMeanAnd90CI(phase2_learn_perf$b_scaledepr_anx_norm_sum)
ReturnPosteriorMeanAnd90CI(phase2_learn_perf$b_scaledepr_anx_norm_sum)
## 
## posterior mean = -0.001386478
## 90% CI =90% HDI: [-0.07, 0.08]
ReturnPosteriorMeanAnd90CI(phase2_learn_perf$b_scaleset_size) # Sanity check this is negative and tight  
## 
## posterior mean = -0.2152095
## 90% CI =90% HDI: [-0.24, -0.19]
#ReturnPosteriorMeanAnd90CI(phase2_learn_perf$b_scaledepr_anx_norm_sum.scaleset_size)
ReturnPosteriorMeanAnd90CI(phase2_learn_perf$b_scaledepr_anx_norm_sum.scaleset_size)
## 
## posterior mean = 0.02697936
## 90% CI =90% HDI: [0.00, 0.05]
# Rum 
cat("\n\n Rumination prop correct phase 2: \n")
## 
## 
##  Rumination prop correct phase 2:
ReturnPosteriorMeanAnd90CI(phase2_rum$b_scalerrs_sum)
## 
## posterior mean = 0.0003879612
## 90% CI =90% HDI: [-0.08, 0.08]
ReturnPosteriorMeanAnd90CI(phase2_rum$b_scaleset_size) # Sanity check - v consistent with above  
## 
## posterior mean = -0.2149793
## 90% CI =90% HDI: [-0.24, -0.19]
ReturnPosteriorMeanAnd90CI(phase2_rum$b_scalerrs_sum.scaleset_size)
## 
## posterior mean = 0.01623668
## 90% CI =90% HDI: [-0.01, 0.04]

Test

# DA  
cat("\n\n Depression prop correct test: \n")
## 
## 
##  Depression prop correct test:
#ReturnPosteriorMeanAnd90CI(test_perf$b_scaledepr_anx_norm_sum)
ReturnPosteriorMeanAnd90CI(test_perf$b_scaledepr_anx_norm_sum)
## 
## posterior mean = 0.01058279
## 90% CI =90% HDI: [-0.07, 0.10]
# Rum 
cat("\n\n Rumination prop correct test: \n")
## 
## 
##  Rumination prop correct test:
ReturnPosteriorMeanAnd90CI(test_rum$b_scalerrs_sum)
## 
## posterior mean = 0.004301401
## 90% CI =90% HDI: [-0.08, 0.09]

Neutral preference ~ symptoms

Learning

The intercept posteriors show that the evidence for a neutral preference found in the frequentist models holds in these Bayesian regression models, now while also controlling for psychiatric symptoms

cat("\n Depression : \n")
## 
##  Depression :
cat("\n Evidence controlling for depression : "); ReturnPosteriorMeanAnd90CI(np_da$b_Intercept)
## 
##  Evidence controlling for depression :
## 
## posterior mean = 0.08778346
## 90% CI =90% HDI: [0.06, 0.11]
cat("\n Evidence for depession effect : ");ReturnPosteriorMeanAnd90CI(np_da$b_scaledepr_anx_norm_sum)
## 
##  Evidence for depession effect :
## 
## posterior mean = -0.01227345
## 90% CI =90% HDI: [-0.04, 0.01]
cat("\n Rumination : \n")
## 
##  Rumination :
cat("\n Evidence controlling for rumination : "); ReturnPosteriorMeanAnd90CI(np_rum$b_Intercept)
## 
##  Evidence controlling for rumination :
## 
## posterior mean = 0.08747077
## 90% CI =90% HDI: [0.06, 0.11]
cat("\n Evidence for rumination effect : ");ReturnPosteriorMeanAnd90CI(np_rum$b_scalerrs_sum)
## 
##  Evidence for rumination effect :
## 
## posterior mean = 0.004026421
## 90% CI =90% HDI: [-0.02, 0.03]

Test

Note that HDI for intercept (indicating neutral pref at test) includes 0 (although it’s close controlling for depression symptoms)

cat("\n Depression : \n")
## 
##  Depression :
cat("\n Evidence controlling for depression : "); ReturnPosteriorMeanAnd90CI(np_test_da$b_Intercept)
## 
##  Evidence controlling for depression :
## 
## posterior mean = 0.03837409
## 90% CI =90% HDI: [-0.01, 0.08]
cat("\n Evidence for depession effect : ");ReturnPosteriorMeanAnd90CI(np_test_da$b_scaledepr_anx_norm_sum)
## 
##  Evidence for depession effect :
## 
## posterior mean = -0.00722852
## 90% CI =90% HDI: [-0.06, 0.05]
cat("\n Rumination : \n")
## 
##  Rumination :
cat("\n Evidence controlling for rumination : "); ReturnPosteriorMeanAnd90CI(np_test_rum$b_Intercept)
## 
##  Evidence controlling for rumination :
## 
## posterior mean = 0.03967129
## 90% CI =90% HDI: [-0.01, 0.09]
cat("\n Evidence for rumination effect : ");ReturnPosteriorMeanAnd90CI(np_test_rum$b_scalerrs_sum)
## 
##  Evidence for rumination effect :
## 
## posterior mean = -0.00610522
## 90% CI =90% HDI: [-0.06, 0.05]

Make sure Rhats below 1.1

CheckRhat("../model_res/brms_res/Rhatreduced_correct_perf_model_phase2__14248__.csv")
## [1] TRUE
CheckRhat("../model_res/brms_res/Rhatreduced_perf_model_phase1__75567__.csv")
## [1] TRUE
CheckRhat("../model_res/brms_res/Rhatreduced_correct_test_model__89989__.csv")
## [1] TRUE
CheckRhat("../model_res/brms_res/Rhatneutral_pref_learn_model__30606__.csv")
## [1] TRUE
CheckRhat("../model_res/brms_res/Rhatneutral_pref_test_model_0int__18974__.csv")
## [1] TRUE
CheckRhat("../model_res/brms_res/RhatRUM_neutral_pref_learn_model__89767__.csv")
## [1] TRUE
CheckRhat("../model_res/brms_res/RhatRUM_neutral_pref_test_model__71650__.csv")
## [1] TRUE
CheckRhat("../model_res/brms_res/RhatRUM_reduced_correct_perf_model_phase2__25543__.csv")
## [1] TRUE
CheckRhat("../model_res/brms_res/RhatRUM_reduced_perf_model_phase1__63279__.csv")
## [1] TRUE
CheckRhat("../model_res/brms_res/RhatRUM_reduced_correct_test_model__53350__.csv")
## [1] TRUE

Get ready to plot proportion correct posterior for depr/anxiety …

depr_anx_learn_perf_posteriors <- rbind(
  data.frame("trace"=phase1_learn_perf$b_scaledepr_anx_norm_sum, "label"="da_main_effect", "phase"="Learn Phase 1"),
  data.frame("trace"=phase2_learn_perf$b_scaledepr_anx_norm_sum, "label"="da_main_effect", "phase"="Learn Phase 2"),
  data.frame("trace"=phase1_learn_perf$b_scaledepr_anx_norm_sum.scaleset_size, 
             "label"="da_ss_int", "phase"="Learn Phase 1"),
  data.frame("trace"=phase2_learn_perf$b_scaledepr_anx_norm_sum.scaleset_size, 
             "label"="da_ss_int", "phase"="Learn Phase 2")
)  

depr_anx_test_perf_posterior <- rbind(
  data.frame("trace"=test_perf$b_scaledepr_anx_norm_sum, "label"="da_main_effect", "phase"="Test")
)  
learn_correct_posterior_p <- ggplot(depr_anx_learn_perf_posteriors,
       aes(x=trace, color=label)) + 
  geom_vline(xintercept=0, color="gray20", size=1.5) +
  geom_density(fill="gray57", alpha=.15, size=1.5) +
  facet_wrap(~ phase, ncol=1) + ga + ap + 
  scale_color_manual(values=c("tan1", "chocolate")) +  ylab("") + 
  theme(axis.text.x = element_text(size=15), axis.ticks=element_blank(), axis.text.y=element_blank()) +
  #labs(title="Learning") +
  labs(title="") +
  tol + xlab("") + theme(strip.text.x = element_text(size = 15)) + tp
learn_correct_posterior_p

test_correct_posterior_p <-ggplot(depr_anx_test_perf_posterior,
       aes(x=trace, color=label)) + 
  geom_vline(xintercept=0, color="gray20", size=1.5) +
  geom_density(fill="gray57", alpha=.15, size=1.5) +
  facet_wrap(~ phase, ncol=1) +
  ga + ap + 
  scale_color_manual(values=c("tan1")) +  
  ylab("") + 
  theme(axis.text.x = element_text(size=15), 
        axis.ticks=element_blank(), axis.text.y=element_blank()) +
  #labs(title="Test") +
  tol + xlab("") + theme(strip.text.x = element_text(size = 15)) + tp #+ 
test_correct_posterior_p 

# Resaved with now-supp 4/25 bc now this fig in supplement
# ggsave("../paper/figs/pieces/now-supp-fig7_learn_correct_posterior_p.png", learn_correct_posterior_p, width=2.2, height=3.3, dpi=500)
# ggsave("../paper/figs/pieces/now-supp-fig7_test_correct_posterior_p.png",
#        test_correct_posterior_p, width=2.2, height=1.65, dpi=500)

… and rum

rum_learn_perf_posteriors <- rbind(
  data.frame("trace"=phase1_rum$b_scalerrs_sum, "label"="rum_main_effect", "phase"="Learn Phase 1"),
  data.frame("trace"=phase2_rum$b_scalerrs_sum, "label"="rum_main_effect", "phase"="Learn Phase 2"),
  data.frame("trace"=phase1_rum$b_scalerrs_sum.scaleset_size, 
             "label"="rum_ss_int", "phase"="Learn Phase 1"),
  data.frame("trace"=phase2_rum$b_scalerrs_sum.scaleset_size, 
             "label"="rum_ss_int", "phase"="Learn Phase 2")
)  

rum_test_perf_posterior <- rbind(
  data.frame("trace"=test_rum$b_scalerrs_sum, "label"="rum_main_effect", "phase"="Test")
)  
learn_correct_posterior_p_RUM <- 
  ggplot(rum_learn_perf_posteriors,
       aes(x=trace, color=label)) + 
  geom_vline(xintercept=0, color="gray20", size=1.5) +
  geom_density(fill="gray57", alpha=.15, size=1.5) +
  facet_wrap(~ phase, ncol=1) + ga + ap + 
  scale_color_manual(values=c("indianred2", "darkred")) +  ylab("") + 
  theme(axis.text.x = element_text(size=15), axis.ticks=element_blank(), axis.text.y=element_blank()) +
  #labs(title="Learning") +
  labs(title="") +
  tol + xlab("") + theme(strip.text.x = element_text(size = 15)) + tp
learn_correct_posterior_p_RUM

test_correct_posterior_p_RUM <-
  ggplot(rum_test_perf_posterior,
       aes(x=trace, color=label)) + 
  geom_vline(xintercept=0, color="gray20", size=1.5) +
  geom_density(fill="gray57", alpha=.15, size=1.5) +
  facet_wrap(~ phase, ncol=1) +
  ga + ap + 
  scale_color_manual(values=c("indianred1")) +  
  ylab("") + 
  theme(axis.text.x = element_text(size=15), axis.ticks=element_blank(), axis.text.y=element_blank()) +
  #labs(title="Test") +
  tol + xlab("") + theme(strip.text.x = element_text(size = 15)) + tp #+ 
test_correct_posterior_p_RUM

# ggsave("../paper/figs/pieces/fig7_learn_correct_posterior_p_RUM.png", learn_correct_posterior_p_RUM, width=2.2, height=3.3, dpi=500)
# ggsave("../paper/figs/pieces/fig7_test_correct_posterior_p_RUM.png",
#        test_correct_posterior_p_RUM, width=2.2, height=1.65, dpi=500)

Get ready to plot neutral pref posterior for depr/anxiety and rum

depr_anx_np_posteriors <- rbind(
  data.frame("trace"=np_da$b_scaledepr_anx_norm_sum, "label"="da_effect", "phase"="Learn"),
  data.frame("trace"=np_test_da$b_scaledepr_anx_norm_sum, "label"="da_main_effect", "phase"="Test")
)  

rum_np_posteriors <- rbind(
  data.frame("trace"=np_rum$b_scalerrs_sum, "label"="rum_effect", "phase"="Learn"),
  data.frame("trace"=np_test_rum$b_scalerrs_sum, "label"="da_main_effect", "phase"="Test")
)  
np_da_posterior_p <- 
  ggplot(depr_anx_np_posteriors,
       aes(x=trace, color=label)) + 
  geom_vline(xintercept=0, color="gray20", size=1.5) +
  geom_density(fill="gray57", alpha=.15, size=1.5) +
  facet_wrap(~ phase, ncol=1) + ga + ap + 
  scale_color_manual(values=c("tan1", "tan1")) +  ylab("") + 
  theme(axis.text.x = element_text(size=10), axis.ticks=element_blank(), axis.text.y=element_blank()) +
  #labs(title="Learning") +
  labs(title="") +
  tol + xlab("") + theme(strip.text.x = element_text(size = 15)) + tp 
  
np_da_posterior_p 

rum_np_posterior_p <- 
  ggplot(rum_np_posteriors,
       aes(x=trace, color=label)) + 
  geom_vline(xintercept=0, color="gray20", size=1.5) +
  geom_density(fill="gray57", alpha=.15, size=1.5) +
  facet_wrap(~ phase, ncol=1) + ga + ap + 
  scale_color_manual(values=c("indianred2", "indianred2")) +  ylab("") + 
  theme(axis.text.x = element_text(size=10), axis.ticks=element_blank(), axis.text.y=element_blank()) +
  #labs(title="Learning") +
  labs(title="") +
  tol + xlab("") + theme(strip.text.x = element_text(size = 15)) + tp 
  
rum_np_posterior_p

# ggsave("../paper/figs/pieces/now-supp-test-fig7_np_da_posterior_p.png", np_da_posterior_p ,
#        width=2.2, height=3.3, dpi=500) # new name 4/25/25
# ggsave("../paper/figs/pieces/fig7_rum_np_posterior_p.png",
#        rum_np_posterior_p, width=2.2, height=3.3, dpi=500)

Symptoms ~ model parameters

learn_m <- learn_df %>%  group_by(ID) %>% summarize(m=mean(correct))
assert(all(learn_m$ID==qdf$ID))
test_m <- test_df %>%  group_by(ID) %>% summarize(m=mean(correct))
assert(all(learn_m$ID==qdf$ID))
assert(all(m35$ID==qdf$ID))
assert(all(m35$ID==learn_m$ID))
assert(all(m35$ID==test_m$ID))
#m35$depr_anx_norm_sum <- qdf$depr_anx_norm_sum
m35$depr_anx_norm_sum <- qdf$depr_anx_norm_sum
m35$BDI_sum <- qdf$BDI_sum
m35$GAD_sum <- qdf$GAD_sum
m35$RRS_sum <- qdf$RRS_sum
m35$learn_m <- learn_m$m
m35$test_m <- test_m$m

Many parameters predict learning and test performance…

summary(learn_preds_bayes <- rstanarm::stan_glm(
  scale(learn_m) ~
             scale(kappa) +
             scale(alpha_pos) +
             scale(alpha_neg) +
             scale(phi) +
             scale(rho) +
             scale(rl_off) +
             scale(epsilon) +
             scale(not_pun_bonus), 
             data=m35))
## 
## SAMPLING FOR MODEL 'continuous' NOW (CHAIN 1).
## Chain 1: 
## Chain 1: Gradient evaluation took 3.6e-05 seconds
## Chain 1: 1000 transitions using 10 leapfrog steps per transition would take 0.36 seconds.
## Chain 1: Adjust your expectations accordingly!
## Chain 1: 
## Chain 1: 
## Chain 1: Iteration:    1 / 2000 [  0%]  (Warmup)
## Chain 1: Iteration:  200 / 2000 [ 10%]  (Warmup)
## Chain 1: Iteration:  400 / 2000 [ 20%]  (Warmup)
## Chain 1: Iteration:  600 / 2000 [ 30%]  (Warmup)
## Chain 1: Iteration:  800 / 2000 [ 40%]  (Warmup)
## Chain 1: Iteration: 1000 / 2000 [ 50%]  (Warmup)
## Chain 1: Iteration: 1001 / 2000 [ 50%]  (Sampling)
## Chain 1: Iteration: 1200 / 2000 [ 60%]  (Sampling)
## Chain 1: Iteration: 1400 / 2000 [ 70%]  (Sampling)
## Chain 1: Iteration: 1600 / 2000 [ 80%]  (Sampling)
## Chain 1: Iteration: 1800 / 2000 [ 90%]  (Sampling)
## Chain 1: Iteration: 2000 / 2000 [100%]  (Sampling)
## Chain 1: 
## Chain 1:  Elapsed Time: 0.033 seconds (Warm-up)
## Chain 1:                0.053 seconds (Sampling)
## Chain 1:                0.086 seconds (Total)
## Chain 1: 
## 
## SAMPLING FOR MODEL 'continuous' NOW (CHAIN 2).
## Chain 2: 
## Chain 2: Gradient evaluation took 5e-06 seconds
## Chain 2: 1000 transitions using 10 leapfrog steps per transition would take 0.05 seconds.
## Chain 2: Adjust your expectations accordingly!
## Chain 2: 
## Chain 2: 
## Chain 2: Iteration:    1 / 2000 [  0%]  (Warmup)
## Chain 2: Iteration:  200 / 2000 [ 10%]  (Warmup)
## Chain 2: Iteration:  400 / 2000 [ 20%]  (Warmup)
## Chain 2: Iteration:  600 / 2000 [ 30%]  (Warmup)
## Chain 2: Iteration:  800 / 2000 [ 40%]  (Warmup)
## Chain 2: Iteration: 1000 / 2000 [ 50%]  (Warmup)
## Chain 2: Iteration: 1001 / 2000 [ 50%]  (Sampling)
## Chain 2: Iteration: 1200 / 2000 [ 60%]  (Sampling)
## Chain 2: Iteration: 1400 / 2000 [ 70%]  (Sampling)
## Chain 2: Iteration: 1600 / 2000 [ 80%]  (Sampling)
## Chain 2: Iteration: 1800 / 2000 [ 90%]  (Sampling)
## Chain 2: Iteration: 2000 / 2000 [100%]  (Sampling)
## Chain 2: 
## Chain 2:  Elapsed Time: 0.033 seconds (Warm-up)
## Chain 2:                0.043 seconds (Sampling)
## Chain 2:                0.076 seconds (Total)
## Chain 2: 
## 
## SAMPLING FOR MODEL 'continuous' NOW (CHAIN 3).
## Chain 3: 
## Chain 3: Gradient evaluation took 4e-06 seconds
## Chain 3: 1000 transitions using 10 leapfrog steps per transition would take 0.04 seconds.
## Chain 3: Adjust your expectations accordingly!
## Chain 3: 
## Chain 3: 
## Chain 3: Iteration:    1 / 2000 [  0%]  (Warmup)
## Chain 3: Iteration:  200 / 2000 [ 10%]  (Warmup)
## Chain 3: Iteration:  400 / 2000 [ 20%]  (Warmup)
## Chain 3: Iteration:  600 / 2000 [ 30%]  (Warmup)
## Chain 3: Iteration:  800 / 2000 [ 40%]  (Warmup)
## Chain 3: Iteration: 1000 / 2000 [ 50%]  (Warmup)
## Chain 3: Iteration: 1001 / 2000 [ 50%]  (Sampling)
## Chain 3: Iteration: 1200 / 2000 [ 60%]  (Sampling)
## Chain 3: Iteration: 1400 / 2000 [ 70%]  (Sampling)
## Chain 3: Iteration: 1600 / 2000 [ 80%]  (Sampling)
## Chain 3: Iteration: 1800 / 2000 [ 90%]  (Sampling)
## Chain 3: Iteration: 2000 / 2000 [100%]  (Sampling)
## Chain 3: 
## Chain 3:  Elapsed Time: 0.033 seconds (Warm-up)
## Chain 3:                0.055 seconds (Sampling)
## Chain 3:                0.088 seconds (Total)
## Chain 3: 
## 
## SAMPLING FOR MODEL 'continuous' NOW (CHAIN 4).
## Chain 4: 
## Chain 4: Gradient evaluation took 5e-06 seconds
## Chain 4: 1000 transitions using 10 leapfrog steps per transition would take 0.05 seconds.
## Chain 4: Adjust your expectations accordingly!
## Chain 4: 
## Chain 4: 
## Chain 4: Iteration:    1 / 2000 [  0%]  (Warmup)
## Chain 4: Iteration:  200 / 2000 [ 10%]  (Warmup)
## Chain 4: Iteration:  400 / 2000 [ 20%]  (Warmup)
## Chain 4: Iteration:  600 / 2000 [ 30%]  (Warmup)
## Chain 4: Iteration:  800 / 2000 [ 40%]  (Warmup)
## Chain 4: Iteration: 1000 / 2000 [ 50%]  (Warmup)
## Chain 4: Iteration: 1001 / 2000 [ 50%]  (Sampling)
## Chain 4: Iteration: 1200 / 2000 [ 60%]  (Sampling)
## Chain 4: Iteration: 1400 / 2000 [ 70%]  (Sampling)
## Chain 4: Iteration: 1600 / 2000 [ 80%]  (Sampling)
## Chain 4: Iteration: 1800 / 2000 [ 90%]  (Sampling)
## Chain 4: Iteration: 2000 / 2000 [100%]  (Sampling)
## Chain 4: 
## Chain 4:  Elapsed Time: 0.034 seconds (Warm-up)
## Chain 4:                0.049 seconds (Sampling)
## Chain 4:                0.083 seconds (Total)
## Chain 4:
## 
## Model Info:
##  function:     stan_glm
##  family:       gaussian [identity]
##  formula:      scale(learn_m) ~ scale(kappa) + scale(alpha_pos) + scale(alpha_neg) + 
##     scale(phi) + scale(rho) + scale(rl_off) + scale(epsilon) + 
##     scale(not_pun_bonus)
##  algorithm:    sampling
##  sample:       4000 (posterior sample size)
##  priors:       see help('prior_summary')
##  observations: 275
##  predictors:   9
## 
## Estimates:
##                        mean   sd   10%   50%   90%
## (Intercept)           0.0    0.0  0.0   0.0   0.0 
## scale(kappa)          0.3    0.0  0.2   0.3   0.3 
## scale(alpha_pos)      0.4    0.0  0.4   0.4   0.5 
## scale(alpha_neg)      0.2    0.0  0.1   0.2   0.2 
## scale(phi)           -0.3    0.0 -0.3  -0.3  -0.2 
## scale(rho)            0.1    0.0  0.1   0.1   0.2 
## scale(rl_off)        -0.3    0.0 -0.3  -0.3  -0.2 
## scale(epsilon)       -0.3    0.0 -0.3  -0.3  -0.3 
## scale(not_pun_bonus) -0.1    0.0 -0.2  -0.1  -0.1 
## sigma                 0.5    0.0  0.5   0.5   0.6 
## 
## Fit Diagnostics:
##            mean   sd   10%   50%   90%
## mean_PPD  0.0    0.0 -0.1   0.0   0.1 
## 
## The mean_ppd is the sample average posterior predictive distribution of the outcome variable (for details see help('summary.stanreg')).
## 
## MCMC diagnostics
##                      mcse Rhat n_eff
## (Intercept)          0.0  1.0  4359 
## scale(kappa)         0.0  1.0  3394 
## scale(alpha_pos)     0.0  1.0  3898 
## scale(alpha_neg)     0.0  1.0  4621 
## scale(phi)           0.0  1.0  3732 
## scale(rho)           0.0  1.0  3108 
## scale(rl_off)        0.0  1.0  3792 
## scale(epsilon)       0.0  1.0  4599 
## scale(not_pun_bonus) 0.0  1.0  4273 
## sigma                0.0  1.0  3691 
## mean_PPD             0.0  1.0  4227 
## log-posterior        0.1  1.0  1739 
## 
## For each parameter, mcse is Monte Carlo standard error, n_eff is a crude measure of effective sample size, and Rhat is the potential scale reduction factor on split chains (at convergence Rhat=1).
summary(test_preds_bayes <- rstanarm::stan_glm(
  scale(test_m) ~
             scale(kappa) +
             scale(alpha_pos) +
             scale(alpha_neg) +
             scale(phi) +
             scale(rho) +
             scale(rl_off) +
             scale(epsilon) +
             scale(not_pun_bonus), 
             data=m35))
## 
## SAMPLING FOR MODEL 'continuous' NOW (CHAIN 1).
## Chain 1: 
## Chain 1: Gradient evaluation took 1.1e-05 seconds
## Chain 1: 1000 transitions using 10 leapfrog steps per transition would take 0.11 seconds.
## Chain 1: Adjust your expectations accordingly!
## Chain 1: 
## Chain 1: 
## Chain 1: Iteration:    1 / 2000 [  0%]  (Warmup)
## Chain 1: Iteration:  200 / 2000 [ 10%]  (Warmup)
## Chain 1: Iteration:  400 / 2000 [ 20%]  (Warmup)
## Chain 1: Iteration:  600 / 2000 [ 30%]  (Warmup)
## Chain 1: Iteration:  800 / 2000 [ 40%]  (Warmup)
## Chain 1: Iteration: 1000 / 2000 [ 50%]  (Warmup)
## Chain 1: Iteration: 1001 / 2000 [ 50%]  (Sampling)
## Chain 1: Iteration: 1200 / 2000 [ 60%]  (Sampling)
## Chain 1: Iteration: 1400 / 2000 [ 70%]  (Sampling)
## Chain 1: Iteration: 1600 / 2000 [ 80%]  (Sampling)
## Chain 1: Iteration: 1800 / 2000 [ 90%]  (Sampling)
## Chain 1: Iteration: 2000 / 2000 [100%]  (Sampling)
## Chain 1: 
## Chain 1:  Elapsed Time: 0.032 seconds (Warm-up)
## Chain 1:                0.047 seconds (Sampling)
## Chain 1:                0.079 seconds (Total)
## Chain 1: 
## 
## SAMPLING FOR MODEL 'continuous' NOW (CHAIN 2).
## Chain 2: 
## Chain 2: Gradient evaluation took 8e-06 seconds
## Chain 2: 1000 transitions using 10 leapfrog steps per transition would take 0.08 seconds.
## Chain 2: Adjust your expectations accordingly!
## Chain 2: 
## Chain 2: 
## Chain 2: Iteration:    1 / 2000 [  0%]  (Warmup)
## Chain 2: Iteration:  200 / 2000 [ 10%]  (Warmup)
## Chain 2: Iteration:  400 / 2000 [ 20%]  (Warmup)
## Chain 2: Iteration:  600 / 2000 [ 30%]  (Warmup)
## Chain 2: Iteration:  800 / 2000 [ 40%]  (Warmup)
## Chain 2: Iteration: 1000 / 2000 [ 50%]  (Warmup)
## Chain 2: Iteration: 1001 / 2000 [ 50%]  (Sampling)
## Chain 2: Iteration: 1200 / 2000 [ 60%]  (Sampling)
## Chain 2: Iteration: 1400 / 2000 [ 70%]  (Sampling)
## Chain 2: Iteration: 1600 / 2000 [ 80%]  (Sampling)
## Chain 2: Iteration: 1800 / 2000 [ 90%]  (Sampling)
## Chain 2: Iteration: 2000 / 2000 [100%]  (Sampling)
## Chain 2: 
## Chain 2:  Elapsed Time: 0.031 seconds (Warm-up)
## Chain 2:                0.041 seconds (Sampling)
## Chain 2:                0.072 seconds (Total)
## Chain 2: 
## 
## SAMPLING FOR MODEL 'continuous' NOW (CHAIN 3).
## Chain 3: 
## Chain 3: Gradient evaluation took 1.3e-05 seconds
## Chain 3: 1000 transitions using 10 leapfrog steps per transition would take 0.13 seconds.
## Chain 3: Adjust your expectations accordingly!
## Chain 3: 
## Chain 3: 
## Chain 3: Iteration:    1 / 2000 [  0%]  (Warmup)
## Chain 3: Iteration:  200 / 2000 [ 10%]  (Warmup)
## Chain 3: Iteration:  400 / 2000 [ 20%]  (Warmup)
## Chain 3: Iteration:  600 / 2000 [ 30%]  (Warmup)
## Chain 3: Iteration:  800 / 2000 [ 40%]  (Warmup)
## Chain 3: Iteration: 1000 / 2000 [ 50%]  (Warmup)
## Chain 3: Iteration: 1001 / 2000 [ 50%]  (Sampling)
## Chain 3: Iteration: 1200 / 2000 [ 60%]  (Sampling)
## Chain 3: Iteration: 1400 / 2000 [ 70%]  (Sampling)
## Chain 3: Iteration: 1600 / 2000 [ 80%]  (Sampling)
## Chain 3: Iteration: 1800 / 2000 [ 90%]  (Sampling)
## Chain 3: Iteration: 2000 / 2000 [100%]  (Sampling)
## Chain 3: 
## Chain 3:  Elapsed Time: 0.033 seconds (Warm-up)
## Chain 3:                0.047 seconds (Sampling)
## Chain 3:                0.08 seconds (Total)
## Chain 3: 
## 
## SAMPLING FOR MODEL 'continuous' NOW (CHAIN 4).
## Chain 4: 
## Chain 4: Gradient evaluation took 7e-06 seconds
## Chain 4: 1000 transitions using 10 leapfrog steps per transition would take 0.07 seconds.
## Chain 4: Adjust your expectations accordingly!
## Chain 4: 
## Chain 4: 
## Chain 4: Iteration:    1 / 2000 [  0%]  (Warmup)
## Chain 4: Iteration:  200 / 2000 [ 10%]  (Warmup)
## Chain 4: Iteration:  400 / 2000 [ 20%]  (Warmup)
## Chain 4: Iteration:  600 / 2000 [ 30%]  (Warmup)
## Chain 4: Iteration:  800 / 2000 [ 40%]  (Warmup)
## Chain 4: Iteration: 1000 / 2000 [ 50%]  (Warmup)
## Chain 4: Iteration: 1001 / 2000 [ 50%]  (Sampling)
## Chain 4: Iteration: 1200 / 2000 [ 60%]  (Sampling)
## Chain 4: Iteration: 1400 / 2000 [ 70%]  (Sampling)
## Chain 4: Iteration: 1600 / 2000 [ 80%]  (Sampling)
## Chain 4: Iteration: 1800 / 2000 [ 90%]  (Sampling)
## Chain 4: Iteration: 2000 / 2000 [100%]  (Sampling)
## Chain 4: 
## Chain 4:  Elapsed Time: 0.033 seconds (Warm-up)
## Chain 4:                0.045 seconds (Sampling)
## Chain 4:                0.078 seconds (Total)
## Chain 4:
## 
## Model Info:
##  function:     stan_glm
##  family:       gaussian [identity]
##  formula:      scale(test_m) ~ scale(kappa) + scale(alpha_pos) + scale(alpha_neg) + 
##     scale(phi) + scale(rho) + scale(rl_off) + scale(epsilon) + 
##     scale(not_pun_bonus)
##  algorithm:    sampling
##  sample:       4000 (posterior sample size)
##  priors:       see help('prior_summary')
##  observations: 275
##  predictors:   9
## 
## Estimates:
##                        mean   sd   10%   50%   90%
## (Intercept)           0.0    0.0  0.0   0.0   0.0 
## scale(kappa)          0.1    0.0  0.0   0.1   0.1 
## scale(alpha_pos)      0.6    0.0  0.6   0.6   0.7 
## scale(alpha_neg)      0.2    0.0  0.1   0.2   0.2 
## scale(phi)           -0.2    0.0 -0.2  -0.2  -0.1 
## scale(rho)            0.1    0.0  0.0   0.1   0.1 
## scale(rl_off)        -0.5    0.0 -0.5  -0.5  -0.4 
## scale(epsilon)       -0.2    0.0 -0.2  -0.2  -0.1 
## scale(not_pun_bonus)  0.0    0.0 -0.1   0.0   0.0 
## sigma                 0.5    0.0  0.5   0.5   0.6 
## 
## Fit Diagnostics:
##            mean   sd   10%   50%   90%
## mean_PPD  0.0    0.0 -0.1   0.0   0.1 
## 
## The mean_ppd is the sample average posterior predictive distribution of the outcome variable (for details see help('summary.stanreg')).
## 
## MCMC diagnostics
##                      mcse Rhat n_eff
## (Intercept)          0.0  1.0  4606 
## scale(kappa)         0.0  1.0  3288 
## scale(alpha_pos)     0.0  1.0  3536 
## scale(alpha_neg)     0.0  1.0  4877 
## scale(phi)           0.0  1.0  3940 
## scale(rho)           0.0  1.0  4505 
## scale(rl_off)        0.0  1.0  3476 
## scale(epsilon)       0.0  1.0  4388 
## scale(not_pun_bonus) 0.0  1.0  5077 
## sigma                0.0  1.0  4290 
## mean_PPD             0.0  1.0  4136 
## log-posterior        0.1  1.0  1659 
## 
## For each parameter, mcse is Monte Carlo standard error, n_eff is a crude measure of effective sample size, and Rhat is the potential scale reduction factor on split chains (at convergence Rhat=1).
summary(da_preds_bayes <- rstanarm::stan_glm(
  scale(depr_anx_norm_sum) ~
             scale(kappa) +
             scale(alpha_pos) +
             scale(alpha_neg) +
             scale(phi) +
             scale(rho) +
             scale(rl_off) +
             scale(epsilon) +
             scale(not_pun_bonus), 
             data=m35))
## 
## SAMPLING FOR MODEL 'continuous' NOW (CHAIN 1).
## Chain 1: 
## Chain 1: Gradient evaluation took 1.7e-05 seconds
## Chain 1: 1000 transitions using 10 leapfrog steps per transition would take 0.17 seconds.
## Chain 1: Adjust your expectations accordingly!
## Chain 1: 
## Chain 1: 
## Chain 1: Iteration:    1 / 2000 [  0%]  (Warmup)
## Chain 1: Iteration:  200 / 2000 [ 10%]  (Warmup)
## Chain 1: Iteration:  400 / 2000 [ 20%]  (Warmup)
## Chain 1: Iteration:  600 / 2000 [ 30%]  (Warmup)
## Chain 1: Iteration:  800 / 2000 [ 40%]  (Warmup)
## Chain 1: Iteration: 1000 / 2000 [ 50%]  (Warmup)
## Chain 1: Iteration: 1001 / 2000 [ 50%]  (Sampling)
## Chain 1: Iteration: 1200 / 2000 [ 60%]  (Sampling)
## Chain 1: Iteration: 1400 / 2000 [ 70%]  (Sampling)
## Chain 1: Iteration: 1600 / 2000 [ 80%]  (Sampling)
## Chain 1: Iteration: 1800 / 2000 [ 90%]  (Sampling)
## Chain 1: Iteration: 2000 / 2000 [100%]  (Sampling)
## Chain 1: 
## Chain 1:  Elapsed Time: 0.031 seconds (Warm-up)
## Chain 1:                0.055 seconds (Sampling)
## Chain 1:                0.086 seconds (Total)
## Chain 1: 
## 
## SAMPLING FOR MODEL 'continuous' NOW (CHAIN 2).
## Chain 2: 
## Chain 2: Gradient evaluation took 6e-06 seconds
## Chain 2: 1000 transitions using 10 leapfrog steps per transition would take 0.06 seconds.
## Chain 2: Adjust your expectations accordingly!
## Chain 2: 
## Chain 2: 
## Chain 2: Iteration:    1 / 2000 [  0%]  (Warmup)
## Chain 2: Iteration:  200 / 2000 [ 10%]  (Warmup)
## Chain 2: Iteration:  400 / 2000 [ 20%]  (Warmup)
## Chain 2: Iteration:  600 / 2000 [ 30%]  (Warmup)
## Chain 2: Iteration:  800 / 2000 [ 40%]  (Warmup)
## Chain 2: Iteration: 1000 / 2000 [ 50%]  (Warmup)
## Chain 2: Iteration: 1001 / 2000 [ 50%]  (Sampling)
## Chain 2: Iteration: 1200 / 2000 [ 60%]  (Sampling)
## Chain 2: Iteration: 1400 / 2000 [ 70%]  (Sampling)
## Chain 2: Iteration: 1600 / 2000 [ 80%]  (Sampling)
## Chain 2: Iteration: 1800 / 2000 [ 90%]  (Sampling)
## Chain 2: Iteration: 2000 / 2000 [100%]  (Sampling)
## Chain 2: 
## Chain 2:  Elapsed Time: 0.032 seconds (Warm-up)
## Chain 2:                0.059 seconds (Sampling)
## Chain 2:                0.091 seconds (Total)
## Chain 2: 
## 
## SAMPLING FOR MODEL 'continuous' NOW (CHAIN 3).
## Chain 3: 
## Chain 3: Gradient evaluation took 7e-06 seconds
## Chain 3: 1000 transitions using 10 leapfrog steps per transition would take 0.07 seconds.
## Chain 3: Adjust your expectations accordingly!
## Chain 3: 
## Chain 3: 
## Chain 3: Iteration:    1 / 2000 [  0%]  (Warmup)
## Chain 3: Iteration:  200 / 2000 [ 10%]  (Warmup)
## Chain 3: Iteration:  400 / 2000 [ 20%]  (Warmup)
## Chain 3: Iteration:  600 / 2000 [ 30%]  (Warmup)
## Chain 3: Iteration:  800 / 2000 [ 40%]  (Warmup)
## Chain 3: Iteration: 1000 / 2000 [ 50%]  (Warmup)
## Chain 3: Iteration: 1001 / 2000 [ 50%]  (Sampling)
## Chain 3: Iteration: 1200 / 2000 [ 60%]  (Sampling)
## Chain 3: Iteration: 1400 / 2000 [ 70%]  (Sampling)
## Chain 3: Iteration: 1600 / 2000 [ 80%]  (Sampling)
## Chain 3: Iteration: 1800 / 2000 [ 90%]  (Sampling)
## Chain 3: Iteration: 2000 / 2000 [100%]  (Sampling)
## Chain 3: 
## Chain 3:  Elapsed Time: 0.033 seconds (Warm-up)
## Chain 3:                0.049 seconds (Sampling)
## Chain 3:                0.082 seconds (Total)
## Chain 3: 
## 
## SAMPLING FOR MODEL 'continuous' NOW (CHAIN 4).
## Chain 4: 
## Chain 4: Gradient evaluation took 7e-06 seconds
## Chain 4: 1000 transitions using 10 leapfrog steps per transition would take 0.07 seconds.
## Chain 4: Adjust your expectations accordingly!
## Chain 4: 
## Chain 4: 
## Chain 4: Iteration:    1 / 2000 [  0%]  (Warmup)
## Chain 4: Iteration:  200 / 2000 [ 10%]  (Warmup)
## Chain 4: Iteration:  400 / 2000 [ 20%]  (Warmup)
## Chain 4: Iteration:  600 / 2000 [ 30%]  (Warmup)
## Chain 4: Iteration:  800 / 2000 [ 40%]  (Warmup)
## Chain 4: Iteration: 1000 / 2000 [ 50%]  (Warmup)
## Chain 4: Iteration: 1001 / 2000 [ 50%]  (Sampling)
## Chain 4: Iteration: 1200 / 2000 [ 60%]  (Sampling)
## Chain 4: Iteration: 1400 / 2000 [ 70%]  (Sampling)
## Chain 4: Iteration: 1600 / 2000 [ 80%]  (Sampling)
## Chain 4: Iteration: 1800 / 2000 [ 90%]  (Sampling)
## Chain 4: Iteration: 2000 / 2000 [100%]  (Sampling)
## Chain 4: 
## Chain 4:  Elapsed Time: 0.031 seconds (Warm-up)
## Chain 4:                0.048 seconds (Sampling)
## Chain 4:                0.079 seconds (Total)
## Chain 4:
## 
## Model Info:
##  function:     stan_glm
##  family:       gaussian [identity]
##  formula:      scale(depr_anx_norm_sum) ~ scale(kappa) + scale(alpha_pos) + 
##     scale(alpha_neg) + scale(phi) + scale(rho) + scale(rl_off) + 
##     scale(epsilon) + scale(not_pun_bonus)
##  algorithm:    sampling
##  sample:       4000 (posterior sample size)
##  priors:       see help('prior_summary')
##  observations: 275
##  predictors:   9
## 
## Estimates:
##                        mean   sd   10%   50%   90%
## (Intercept)           0.0    0.1 -0.1   0.0   0.1 
## scale(kappa)         -0.1    0.1 -0.2  -0.1   0.0 
## scale(alpha_pos)      0.1    0.1  0.0   0.1   0.2 
## scale(alpha_neg)      0.0    0.1 -0.1   0.0   0.1 
## scale(phi)            0.0    0.1 -0.1   0.0   0.0 
## scale(rho)            0.0    0.1 -0.1   0.0   0.1 
## scale(rl_off)         0.0    0.1 -0.1   0.0   0.1 
## scale(epsilon)        0.1    0.1  0.0   0.1   0.1 
## scale(not_pun_bonus)  0.1    0.1  0.0   0.1   0.1 
## sigma                 1.0    0.0  1.0   1.0   1.1 
## 
## Fit Diagnostics:
##            mean   sd   10%   50%   90%
## mean_PPD  0.0    0.1 -0.1   0.0   0.1 
## 
## The mean_ppd is the sample average posterior predictive distribution of the outcome variable (for details see help('summary.stanreg')).
## 
## MCMC diagnostics
##                      mcse Rhat n_eff
## (Intercept)          0.0  1.0  4709 
## scale(kappa)         0.0  1.0  4101 
## scale(alpha_pos)     0.0  1.0  3362 
## scale(alpha_neg)     0.0  1.0  3994 
## scale(phi)           0.0  1.0  3842 
## scale(rho)           0.0  1.0  4458 
## scale(rl_off)        0.0  1.0  4201 
## scale(epsilon)       0.0  1.0  4429 
## scale(not_pun_bonus) 0.0  1.0  4614 
## sigma                0.0  1.0  4040 
## mean_PPD             0.0  1.0  4288 
## log-posterior        0.1  1.0  1739 
## 
## For each parameter, mcse is Monte Carlo standard error, n_eff is a crude measure of effective sample size, and Rhat is the potential scale reduction factor on split chains (at convergence Rhat=1).
summary(rrs_preds_bayes <- rstanarm::stan_glm(
  scale(RRS_sum) ~
             scale(kappa) +
             scale(alpha_pos) +
             scale(alpha_neg) +
             scale(phi) +
             scale(rho) +
             scale(rl_off) +
             scale(epsilon) +
             scale(not_pun_bonus), 
             data=m35))
## 
## SAMPLING FOR MODEL 'continuous' NOW (CHAIN 1).
## Chain 1: 
## Chain 1: Gradient evaluation took 1.6e-05 seconds
## Chain 1: 1000 transitions using 10 leapfrog steps per transition would take 0.16 seconds.
## Chain 1: Adjust your expectations accordingly!
## Chain 1: 
## Chain 1: 
## Chain 1: Iteration:    1 / 2000 [  0%]  (Warmup)
## Chain 1: Iteration:  200 / 2000 [ 10%]  (Warmup)
## Chain 1: Iteration:  400 / 2000 [ 20%]  (Warmup)
## Chain 1: Iteration:  600 / 2000 [ 30%]  (Warmup)
## Chain 1: Iteration:  800 / 2000 [ 40%]  (Warmup)
## Chain 1: Iteration: 1000 / 2000 [ 50%]  (Warmup)
## Chain 1: Iteration: 1001 / 2000 [ 50%]  (Sampling)
## Chain 1: Iteration: 1200 / 2000 [ 60%]  (Sampling)
## Chain 1: Iteration: 1400 / 2000 [ 70%]  (Sampling)
## Chain 1: Iteration: 1600 / 2000 [ 80%]  (Sampling)
## Chain 1: Iteration: 1800 / 2000 [ 90%]  (Sampling)
## Chain 1: Iteration: 2000 / 2000 [100%]  (Sampling)
## Chain 1: 
## Chain 1:  Elapsed Time: 0.029 seconds (Warm-up)
## Chain 1:                0.047 seconds (Sampling)
## Chain 1:                0.076 seconds (Total)
## Chain 1: 
## 
## SAMPLING FOR MODEL 'continuous' NOW (CHAIN 2).
## Chain 2: 
## Chain 2: Gradient evaluation took 8e-06 seconds
## Chain 2: 1000 transitions using 10 leapfrog steps per transition would take 0.08 seconds.
## Chain 2: Adjust your expectations accordingly!
## Chain 2: 
## Chain 2: 
## Chain 2: Iteration:    1 / 2000 [  0%]  (Warmup)
## Chain 2: Iteration:  200 / 2000 [ 10%]  (Warmup)
## Chain 2: Iteration:  400 / 2000 [ 20%]  (Warmup)
## Chain 2: Iteration:  600 / 2000 [ 30%]  (Warmup)
## Chain 2: Iteration:  800 / 2000 [ 40%]  (Warmup)
## Chain 2: Iteration: 1000 / 2000 [ 50%]  (Warmup)
## Chain 2: Iteration: 1001 / 2000 [ 50%]  (Sampling)
## Chain 2: Iteration: 1200 / 2000 [ 60%]  (Sampling)
## Chain 2: Iteration: 1400 / 2000 [ 70%]  (Sampling)
## Chain 2: Iteration: 1600 / 2000 [ 80%]  (Sampling)
## Chain 2: Iteration: 1800 / 2000 [ 90%]  (Sampling)
## Chain 2: Iteration: 2000 / 2000 [100%]  (Sampling)
## Chain 2: 
## Chain 2:  Elapsed Time: 0.031 seconds (Warm-up)
## Chain 2:                0.051 seconds (Sampling)
## Chain 2:                0.082 seconds (Total)
## Chain 2: 
## 
## SAMPLING FOR MODEL 'continuous' NOW (CHAIN 3).
## Chain 3: 
## Chain 3: Gradient evaluation took 6e-06 seconds
## Chain 3: 1000 transitions using 10 leapfrog steps per transition would take 0.06 seconds.
## Chain 3: Adjust your expectations accordingly!
## Chain 3: 
## Chain 3: 
## Chain 3: Iteration:    1 / 2000 [  0%]  (Warmup)
## Chain 3: Iteration:  200 / 2000 [ 10%]  (Warmup)
## Chain 3: Iteration:  400 / 2000 [ 20%]  (Warmup)
## Chain 3: Iteration:  600 / 2000 [ 30%]  (Warmup)
## Chain 3: Iteration:  800 / 2000 [ 40%]  (Warmup)
## Chain 3: Iteration: 1000 / 2000 [ 50%]  (Warmup)
## Chain 3: Iteration: 1001 / 2000 [ 50%]  (Sampling)
## Chain 3: Iteration: 1200 / 2000 [ 60%]  (Sampling)
## Chain 3: Iteration: 1400 / 2000 [ 70%]  (Sampling)
## Chain 3: Iteration: 1600 / 2000 [ 80%]  (Sampling)
## Chain 3: Iteration: 1800 / 2000 [ 90%]  (Sampling)
## Chain 3: Iteration: 2000 / 2000 [100%]  (Sampling)
## Chain 3: 
## Chain 3:  Elapsed Time: 0.03 seconds (Warm-up)
## Chain 3:                0.046 seconds (Sampling)
## Chain 3:                0.076 seconds (Total)
## Chain 3: 
## 
## SAMPLING FOR MODEL 'continuous' NOW (CHAIN 4).
## Chain 4: 
## Chain 4: Gradient evaluation took 6e-06 seconds
## Chain 4: 1000 transitions using 10 leapfrog steps per transition would take 0.06 seconds.
## Chain 4: Adjust your expectations accordingly!
## Chain 4: 
## Chain 4: 
## Chain 4: Iteration:    1 / 2000 [  0%]  (Warmup)
## Chain 4: Iteration:  200 / 2000 [ 10%]  (Warmup)
## Chain 4: Iteration:  400 / 2000 [ 20%]  (Warmup)
## Chain 4: Iteration:  600 / 2000 [ 30%]  (Warmup)
## Chain 4: Iteration:  800 / 2000 [ 40%]  (Warmup)
## Chain 4: Iteration: 1000 / 2000 [ 50%]  (Warmup)
## Chain 4: Iteration: 1001 / 2000 [ 50%]  (Sampling)
## Chain 4: Iteration: 1200 / 2000 [ 60%]  (Sampling)
## Chain 4: Iteration: 1400 / 2000 [ 70%]  (Sampling)
## Chain 4: Iteration: 1600 / 2000 [ 80%]  (Sampling)
## Chain 4: Iteration: 1800 / 2000 [ 90%]  (Sampling)
## Chain 4: Iteration: 2000 / 2000 [100%]  (Sampling)
## Chain 4: 
## Chain 4:  Elapsed Time: 0.031 seconds (Warm-up)
## Chain 4:                0.048 seconds (Sampling)
## Chain 4:                0.079 seconds (Total)
## Chain 4:
## 
## Model Info:
##  function:     stan_glm
##  family:       gaussian [identity]
##  formula:      scale(RRS_sum) ~ scale(kappa) + scale(alpha_pos) + scale(alpha_neg) + 
##     scale(phi) + scale(rho) + scale(rl_off) + scale(epsilon) + 
##     scale(not_pun_bonus)
##  algorithm:    sampling
##  sample:       4000 (posterior sample size)
##  priors:       see help('prior_summary')
##  observations: 275
##  predictors:   9
## 
## Estimates:
##                        mean   sd   10%   50%   90%
## (Intercept)           0.0    0.1 -0.1   0.0   0.1 
## scale(kappa)          0.0    0.1 -0.1   0.0   0.1 
## scale(alpha_pos)      0.0    0.1 -0.1   0.0   0.1 
## scale(alpha_neg)      0.0    0.1 -0.1   0.0   0.1 
## scale(phi)            0.0    0.1 -0.1   0.0   0.1 
## scale(rho)            0.0    0.1  0.0   0.0   0.1 
## scale(rl_off)         0.0    0.1  0.0   0.0   0.1 
## scale(epsilon)        0.0    0.1  0.0   0.0   0.1 
## scale(not_pun_bonus)  0.0    0.1 -0.1   0.0   0.1 
## sigma                 1.0    0.0  1.0   1.0   1.1 
## 
## Fit Diagnostics:
##            mean   sd   10%   50%   90%
## mean_PPD  0.0    0.1 -0.1   0.0   0.1 
## 
## The mean_ppd is the sample average posterior predictive distribution of the outcome variable (for details see help('summary.stanreg')).
## 
## MCMC diagnostics
##                      mcse Rhat n_eff
## (Intercept)          0.0  1.0  4709 
## scale(kappa)         0.0  1.0  3630 
## scale(alpha_pos)     0.0  1.0  3845 
## scale(alpha_neg)     0.0  1.0  4639 
## scale(phi)           0.0  1.0  3537 
## scale(rho)           0.0  1.0  4444 
## scale(rl_off)        0.0  1.0  3882 
## scale(epsilon)       0.0  1.0  4228 
## scale(not_pun_bonus) 0.0  1.0  3755 
## sigma                0.0  1.0  3941 
## mean_PPD             0.0  1.0  4534 
## log-posterior        0.1  1.0  1931 
## 
## For each parameter, mcse is Monte Carlo standard error, n_eff is a crude measure of effective sample size, and Rhat is the potential scale reduction factor on split chains (at convergence Rhat=1).
packageVersion("rstanarm")
## [1] '2.32.1'

Get traces for each par

learn_traces <- data.frame(as.matrix(learn_preds_bayes))

learn_est <- ExtractEstimates(learn_traces)
learn_est$label <- "Learning"
learn_est$category <- "Proportion correct"
# Drop the coefs that aren't model pars  
learn_est <- learn_est %>% filter(!coef %in% c("sigma", "X.Intercept."))
test_traces <- data.frame(as.matrix(test_preds_bayes))

test_est <- ExtractEstimates(test_traces)
test_est$label <- "Test"
test_est$category <- "Proportion correct"
test_est <- test_est %>% filter(!coef %in% c("sigma", "X.Intercept."))
assert(all(test_est$coef==learn_est$coef))
da_traces <- data.frame(as.matrix(da_preds_bayes))

da_est <- ExtractEstimates(da_traces)
da_est$label <- "Depr/anx"
da_est$category <- "Symptoms"
da_est <- da_est %>% filter(!coef %in% c("sigma", "X.Intercept."))
assert(all(da_est$coef==learn_est$coef))
ReturnPosteriorMeanAnd90CI(da_traces$scale.alpha_neg.)
## 
## posterior mean = 0.006321988
## 90% CI =90% HDI: [-0.09, 0.11]
ReturnPosteriorMeanAnd90CI(da_traces$scale.alpha_pos.) 
## 
## posterior mean = 0.06576186
## 90% CI =90% HDI: [-0.05, 0.19]
ReturnPosteriorMeanAnd90CI(da_traces$scale.kappa.)
## 
## posterior mean = -0.07269568
## 90% CI =90% HDI: [-0.19, 0.04]
ReturnPosteriorMeanAnd90CI(da_traces$scale.phi.)
## 
## posterior mean = -0.04940955
## 90% CI =90% HDI: [-0.16, 0.07]
ReturnPosteriorMeanAnd90CI(da_traces$scale.rho.)
## 
## posterior mean = -0.004457409
## 90% CI =90% HDI: [-0.11, 0.10]
ReturnPosteriorMeanAnd90CI(da_traces$scale.rl_off.)
## 
## posterior mean = 0.008126228
## 90% CI =90% HDI: [-0.10, 0.11]
ReturnPosteriorMeanAnd90CI(da_traces$scale.epsilon.)
## 
## posterior mean = 0.05259689
## 90% CI =90% HDI: [-0.06, 0.15]
ReturnPosteriorMeanAnd90CI(da_traces$scale.not_pun_bonus.)
## 
## posterior mean = 0.06150648
## 90% CI =90% HDI: [-0.05, 0.17]

The three with close to some support

cat("\n Depression and bonus for non-punishing items\n")
## 
##  Depression and bonus for non-punishing items
ReturnPosteriorMeanAnd90CI(da_traces$scale.not_pun_bonus.)
## 
## posterior mean = 0.06150648
## 90% CI =90% HDI: [-0.05, 0.17]
cat("\n Depression and WM decay\n")
## 
##  Depression and WM decay
ReturnPosteriorMeanAnd90CI(da_traces$scale.phi.)
## 
## posterior mean = -0.04940955
## 90% CI =90% HDI: [-0.16, 0.07]
cat("\n Depression and WM capacity\n")
## 
##  Depression and WM capacity
ReturnPosteriorMeanAnd90CI(da_traces$scale.kappa.)
## 
## posterior mean = -0.07269568
## 90% CI =90% HDI: [-0.19, 0.04]
cat("\n Depression and learning rate from negative PEs \n")
## 
##  Depression and learning rate from negative PEs
ReturnPosteriorMeanAnd90CI(da_traces$scale.alpha_neg.)
## 
## posterior mean = 0.006321988
## 90% CI =90% HDI: [-0.09, 0.11]

Robustness check in univariate models the results aligned w hypotheses

summary(npb_da_preds_bayes <- rstanarm::stan_glm(
  scale(depr_anx_norm_sum) ~
             
             scale(not_pun_bonus), 
             data=m35))
## 
## SAMPLING FOR MODEL 'continuous' NOW (CHAIN 1).
## Chain 1: 
## Chain 1: Gradient evaluation took 1.2e-05 seconds
## Chain 1: 1000 transitions using 10 leapfrog steps per transition would take 0.12 seconds.
## Chain 1: Adjust your expectations accordingly!
## Chain 1: 
## Chain 1: 
## Chain 1: Iteration:    1 / 2000 [  0%]  (Warmup)
## Chain 1: Iteration:  200 / 2000 [ 10%]  (Warmup)
## Chain 1: Iteration:  400 / 2000 [ 20%]  (Warmup)
## Chain 1: Iteration:  600 / 2000 [ 30%]  (Warmup)
## Chain 1: Iteration:  800 / 2000 [ 40%]  (Warmup)
## Chain 1: Iteration: 1000 / 2000 [ 50%]  (Warmup)
## Chain 1: Iteration: 1001 / 2000 [ 50%]  (Sampling)
## Chain 1: Iteration: 1200 / 2000 [ 60%]  (Sampling)
## Chain 1: Iteration: 1400 / 2000 [ 70%]  (Sampling)
## Chain 1: Iteration: 1600 / 2000 [ 80%]  (Sampling)
## Chain 1: Iteration: 1800 / 2000 [ 90%]  (Sampling)
## Chain 1: Iteration: 2000 / 2000 [100%]  (Sampling)
## Chain 1: 
## Chain 1:  Elapsed Time: 0.016 seconds (Warm-up)
## Chain 1:                0.033 seconds (Sampling)
## Chain 1:                0.049 seconds (Total)
## Chain 1: 
## 
## SAMPLING FOR MODEL 'continuous' NOW (CHAIN 2).
## Chain 2: 
## Chain 2: Gradient evaluation took 4e-06 seconds
## Chain 2: 1000 transitions using 10 leapfrog steps per transition would take 0.04 seconds.
## Chain 2: Adjust your expectations accordingly!
## Chain 2: 
## Chain 2: 
## Chain 2: Iteration:    1 / 2000 [  0%]  (Warmup)
## Chain 2: Iteration:  200 / 2000 [ 10%]  (Warmup)
## Chain 2: Iteration:  400 / 2000 [ 20%]  (Warmup)
## Chain 2: Iteration:  600 / 2000 [ 30%]  (Warmup)
## Chain 2: Iteration:  800 / 2000 [ 40%]  (Warmup)
## Chain 2: Iteration: 1000 / 2000 [ 50%]  (Warmup)
## Chain 2: Iteration: 1001 / 2000 [ 50%]  (Sampling)
## Chain 2: Iteration: 1200 / 2000 [ 60%]  (Sampling)
## Chain 2: Iteration: 1400 / 2000 [ 70%]  (Sampling)
## Chain 2: Iteration: 1600 / 2000 [ 80%]  (Sampling)
## Chain 2: Iteration: 1800 / 2000 [ 90%]  (Sampling)
## Chain 2: Iteration: 2000 / 2000 [100%]  (Sampling)
## Chain 2: 
## Chain 2:  Elapsed Time: 0.017 seconds (Warm-up)
## Chain 2:                0.033 seconds (Sampling)
## Chain 2:                0.05 seconds (Total)
## Chain 2: 
## 
## SAMPLING FOR MODEL 'continuous' NOW (CHAIN 3).
## Chain 3: 
## Chain 3: Gradient evaluation took 3e-06 seconds
## Chain 3: 1000 transitions using 10 leapfrog steps per transition would take 0.03 seconds.
## Chain 3: Adjust your expectations accordingly!
## Chain 3: 
## Chain 3: 
## Chain 3: Iteration:    1 / 2000 [  0%]  (Warmup)
## Chain 3: Iteration:  200 / 2000 [ 10%]  (Warmup)
## Chain 3: Iteration:  400 / 2000 [ 20%]  (Warmup)
## Chain 3: Iteration:  600 / 2000 [ 30%]  (Warmup)
## Chain 3: Iteration:  800 / 2000 [ 40%]  (Warmup)
## Chain 3: Iteration: 1000 / 2000 [ 50%]  (Warmup)
## Chain 3: Iteration: 1001 / 2000 [ 50%]  (Sampling)
## Chain 3: Iteration: 1200 / 2000 [ 60%]  (Sampling)
## Chain 3: Iteration: 1400 / 2000 [ 70%]  (Sampling)
## Chain 3: Iteration: 1600 / 2000 [ 80%]  (Sampling)
## Chain 3: Iteration: 1800 / 2000 [ 90%]  (Sampling)
## Chain 3: Iteration: 2000 / 2000 [100%]  (Sampling)
## Chain 3: 
## Chain 3:  Elapsed Time: 0.017 seconds (Warm-up)
## Chain 3:                0.034 seconds (Sampling)
## Chain 3:                0.051 seconds (Total)
## Chain 3: 
## 
## SAMPLING FOR MODEL 'continuous' NOW (CHAIN 4).
## Chain 4: 
## Chain 4: Gradient evaluation took 3e-06 seconds
## Chain 4: 1000 transitions using 10 leapfrog steps per transition would take 0.03 seconds.
## Chain 4: Adjust your expectations accordingly!
## Chain 4: 
## Chain 4: 
## Chain 4: Iteration:    1 / 2000 [  0%]  (Warmup)
## Chain 4: Iteration:  200 / 2000 [ 10%]  (Warmup)
## Chain 4: Iteration:  400 / 2000 [ 20%]  (Warmup)
## Chain 4: Iteration:  600 / 2000 [ 30%]  (Warmup)
## Chain 4: Iteration:  800 / 2000 [ 40%]  (Warmup)
## Chain 4: Iteration: 1000 / 2000 [ 50%]  (Warmup)
## Chain 4: Iteration: 1001 / 2000 [ 50%]  (Sampling)
## Chain 4: Iteration: 1200 / 2000 [ 60%]  (Sampling)
## Chain 4: Iteration: 1400 / 2000 [ 70%]  (Sampling)
## Chain 4: Iteration: 1600 / 2000 [ 80%]  (Sampling)
## Chain 4: Iteration: 1800 / 2000 [ 90%]  (Sampling)
## Chain 4: Iteration: 2000 / 2000 [100%]  (Sampling)
## Chain 4: 
## Chain 4:  Elapsed Time: 0.016 seconds (Warm-up)
## Chain 4:                0.033 seconds (Sampling)
## Chain 4:                0.049 seconds (Total)
## Chain 4:
## 
## Model Info:
##  function:     stan_glm
##  family:       gaussian [identity]
##  formula:      scale(depr_anx_norm_sum) ~ scale(not_pun_bonus)
##  algorithm:    sampling
##  sample:       4000 (posterior sample size)
##  priors:       see help('prior_summary')
##  observations: 275
##  predictors:   2
## 
## Estimates:
##                        mean   sd   10%   50%   90%
## (Intercept)           0.0    0.1 -0.1   0.0   0.1 
## scale(not_pun_bonus)  0.0    0.1  0.0   0.0   0.1 
## sigma                 1.0    0.0  1.0   1.0   1.1 
## 
## Fit Diagnostics:
##            mean   sd   10%   50%   90%
## mean_PPD  0.0    0.1 -0.1   0.0   0.1 
## 
## The mean_ppd is the sample average posterior predictive distribution of the outcome variable (for details see help('summary.stanreg')).
## 
## MCMC diagnostics
##                      mcse Rhat n_eff
## (Intercept)          0.0  1.0  3886 
## scale(not_pun_bonus) 0.0  1.0  3983 
## sigma                0.0  1.0  3992 
## mean_PPD             0.0  1.0  3545 
## log-posterior        0.0  1.0  1743 
## 
## For each parameter, mcse is Monte Carlo standard error, n_eff is a crude measure of effective sample size, and Rhat is the potential scale reduction factor on split chains (at convergence Rhat=1).

Of note, results here and elsewhere very slightly discrepant when run within notebook vs. knitted results presumably due to rounding during knit/posterior sampling randomness but does not change results

cat("\n Univariate depression/anxiety  bonus for non-punishing items\n")
## 
##  Univariate depression/anxiety  bonus for non-punishing items
npb_traces <- data.frame(as.matrix(npb_da_preds_bayes))
ReturnPosteriorMeanAnd90CI(npb_traces$scale.not_pun_bonus.)
## 
## posterior mean = 0.04380152
## 90% CI =90% HDI: [-0.05, 0.15]
rrs_traces <- data.frame(as.matrix(rrs_preds_bayes))

rrs_est <- ExtractEstimates(rrs_traces)
rrs_est$label <- "Rumination"
rrs_est$category <- "Symptoms"
rrs_est <- rrs_est %>% filter(!coef %in% c("sigma", "X.Intercept."))

assert(all(rrs_est$coef==test_est$coef))
ReturnPosteriorMeanAnd90CI(rrs_traces$scale.alpha_neg.)
## 
## posterior mean = -0.003605848
## 90% CI =90% HDI: [-0.11, 0.10]
ReturnPosteriorMeanAnd90CI(rrs_traces$scale.alpha_pos.) 
## 
## posterior mean = 0.01410442
## 90% CI =90% HDI: [-0.10, 0.13]
ReturnPosteriorMeanAnd90CI(rrs_traces$scale.kappa.)
## 
## posterior mean = -0.003067976
## 90% CI =90% HDI: [-0.13, 0.11]
ReturnPosteriorMeanAnd90CI(rrs_traces$scale.phi.)
## 
## posterior mean = -0.02468806
## 90% CI =90% HDI: [-0.13, 0.10]
ReturnPosteriorMeanAnd90CI(rrs_traces$scale.rho.)
## 
## posterior mean = 0.03617215
## 90% CI =90% HDI: [-0.07, 0.14]
ReturnPosteriorMeanAnd90CI(rrs_traces$scale.rl_off.)
## 
## posterior mean = 0.04781454
## 90% CI =90% HDI: [-0.06, 0.15]
ReturnPosteriorMeanAnd90CI(rrs_traces$scale.epsilon.)
## 
## posterior mean = 0.03556672
## 90% CI =90% HDI: [-0.07, 0.14]
ReturnPosteriorMeanAnd90CI(rrs_traces$scale.not_pun_bonus.)
## 
## posterior mean = -0.004441763
## 90% CI =90% HDI: [-0.11, 0.09]
all_ests <- rbind(learn_est, test_est, da_est, rrs_est)
all_ests$label <- factor(all_ests$label, levels=c("Learning", "Test", "Depr/anx", "Rumination"))
all_ests_p <- ggplot(all_ests, #%>% filter(category=="Proportion correct"), 
       aes(y=coef, x=m, fill=label)) + 
  geom_vline(xintercept=0, size=1.3, color="gray35") +
  geom_vline(xintercept=c(-.5, -.25, .25, .5), color="gray65") +
  geom_errorbar(aes(xmin=lb_10, xmax=ub_90), width=.2, position=position_dodge(width=.4), size=1.5) +
  geom_point(pch=21, size=5, alpha=.9, position=position_dodge(width=.4)) + ga + ap + lp + 
  ylab("Regression coefficient \n of model parameter") + 
  xlab("Mean and 90% credible interval") +
  scale_y_discrete(labels=rev(c(
    TeX('$\\RL^{off}'),
    TeX('$\\rho'),
    TeX('$\\phi'),
    TeX('$\\n-p_{b}'),
    TeX('$\\kappa'),
    TeX('$\\epsilon'),
    TeX('$\\alpha_{+}'),
    TeX('$\\alpha_{-}')))) + 
   facet_wrap(~category) + ft +
  scale_fill_manual(values=c("skyblue", "blue", "orange", "red")) +
  scale_x_continuous(labels=function(x) sprintf("%.1f", x)) + theme(axis.text.y = element_text(size=32)) #+ tol
all_ests_p

Spot checks of plot

# hist(learn_traces$scale.kappa.)
# hist(test_traces$scale.kappa.)
# hist(da_traces$scale.kappa.)
# hist(learn_traces$scale.rl_off.)
# hist(test_traces$scale.rl_off.)
# hist(da_traces$scale.rl_off.)
# hist(test_traces$scale.alpha_pos.)
# hist(da_traces$scale.alpha_pos.)
# hist(learn_traces$scale.epsilon.)
# hist(test_traces$scale.epsilon.)
write.csv(data.frame("label"=all_ests$label, round(data.frame(all_ests %>% select("lb_10", "ub_90", "m")), 3)), "../data/table_out.csv")
all_ests %>% select("lb_10", "ub_90", "m", "label")
##            lb_10       ub_90            m      label
##  1:  0.195140973  0.32138902  0.254928097   Learning
##  2:  0.369467507  0.48902696  0.430380465   Learning
##  3:  0.101119351  0.20932590  0.155767445   Learning
##  4: -0.328982682 -0.20699146 -0.268258505   Learning
##  5:  0.082596957  0.19535381  0.135892032   Learning
##  6: -0.322487383 -0.21066436 -0.266629784   Learning
##  7: -0.361486815 -0.25343047 -0.307710107   Learning
##  8: -0.168278061 -0.05843847 -0.113879630   Learning
##  9: -0.002987751  0.12349430  0.056973655       Test
## 10:  0.571939774  0.69865542  0.639106491       Test
## 11:  0.114837641  0.22961677  0.171143167       Test
## 12: -0.244599371 -0.11640653 -0.184136587       Test
## 13:  0.016108258  0.13359681  0.078375834       Test
## 14: -0.548142453 -0.43080211 -0.488230454       Test
## 15: -0.225667473 -0.11442703 -0.167417750       Test
## 16: -0.091157489  0.02436631 -0.031551734       Test
## 17: -0.190379528  0.04170365 -0.072695680   Depr/anx
## 18: -0.045987998  0.18543400  0.065761859   Depr/anx
## 19: -0.094262580  0.11309079  0.006321988   Depr/anx
## 20: -0.159465094  0.07220152 -0.049409549   Depr/anx
## 21: -0.114985753  0.09907999 -0.004457409   Depr/anx
## 22: -0.101915451  0.11385131  0.008126228   Depr/anx
## 23: -0.057355683  0.15365766  0.052596893   Depr/anx
## 24: -0.046849917  0.16526104  0.061506484   Depr/anx
## 25: -0.129915857  0.11225926 -0.003067976 Rumination
## 26: -0.104246709  0.12780926  0.014104416 Rumination
## 27: -0.112472041  0.09936537 -0.003605848 Rumination
## 28: -0.134416211  0.10336054 -0.024688056 Rumination
## 29: -0.072173435  0.14489613  0.036172147 Rumination
## 30: -0.061735495  0.15248470  0.047814536 Rumination
## 31: -0.066931399  0.13581224  0.035566715 Rumination
## 32: -0.114943127  0.08943102 -0.004441763 Rumination
##            lb_10       ub_90            m      label
all_ests
##                     coef        lb_10       ub_90            m      label
##  1:         scale.kappa.  0.195140973  0.32138902  0.254928097   Learning
##  2:     scale.alpha_pos.  0.369467507  0.48902696  0.430380465   Learning
##  3:     scale.alpha_neg.  0.101119351  0.20932590  0.155767445   Learning
##  4:           scale.phi. -0.328982682 -0.20699146 -0.268258505   Learning
##  5:           scale.rho.  0.082596957  0.19535381  0.135892032   Learning
##  6:        scale.rl_off. -0.322487383 -0.21066436 -0.266629784   Learning
##  7:       scale.epsilon. -0.361486815 -0.25343047 -0.307710107   Learning
##  8: scale.not_pun_bonus. -0.168278061 -0.05843847 -0.113879630   Learning
##  9:         scale.kappa. -0.002987751  0.12349430  0.056973655       Test
## 10:     scale.alpha_pos.  0.571939774  0.69865542  0.639106491       Test
## 11:     scale.alpha_neg.  0.114837641  0.22961677  0.171143167       Test
## 12:           scale.phi. -0.244599371 -0.11640653 -0.184136587       Test
## 13:           scale.rho.  0.016108258  0.13359681  0.078375834       Test
## 14:        scale.rl_off. -0.548142453 -0.43080211 -0.488230454       Test
## 15:       scale.epsilon. -0.225667473 -0.11442703 -0.167417750       Test
## 16: scale.not_pun_bonus. -0.091157489  0.02436631 -0.031551734       Test
## 17:         scale.kappa. -0.190379528  0.04170365 -0.072695680   Depr/anx
## 18:     scale.alpha_pos. -0.045987998  0.18543400  0.065761859   Depr/anx
## 19:     scale.alpha_neg. -0.094262580  0.11309079  0.006321988   Depr/anx
## 20:           scale.phi. -0.159465094  0.07220152 -0.049409549   Depr/anx
## 21:           scale.rho. -0.114985753  0.09907999 -0.004457409   Depr/anx
## 22:        scale.rl_off. -0.101915451  0.11385131  0.008126228   Depr/anx
## 23:       scale.epsilon. -0.057355683  0.15365766  0.052596893   Depr/anx
## 24: scale.not_pun_bonus. -0.046849917  0.16526104  0.061506484   Depr/anx
## 25:         scale.kappa. -0.129915857  0.11225926 -0.003067976 Rumination
## 26:     scale.alpha_pos. -0.104246709  0.12780926  0.014104416 Rumination
## 27:     scale.alpha_neg. -0.112472041  0.09936537 -0.003605848 Rumination
## 28:           scale.phi. -0.134416211  0.10336054 -0.024688056 Rumination
## 29:           scale.rho. -0.072173435  0.14489613  0.036172147 Rumination
## 30:        scale.rl_off. -0.061735495  0.15248470  0.047814536 Rumination
## 31:       scale.epsilon. -0.066931399  0.13581224  0.035566715 Rumination
## 32: scale.not_pun_bonus. -0.114943127  0.08943102 -0.004441763 Rumination
##                     coef        lb_10       ub_90            m      label
##               category
##  1: Proportion correct
##  2: Proportion correct
##  3: Proportion correct
##  4: Proportion correct
##  5: Proportion correct
##  6: Proportion correct
##  7: Proportion correct
##  8: Proportion correct
##  9: Proportion correct
## 10: Proportion correct
## 11: Proportion correct
## 12: Proportion correct
## 13: Proportion correct
## 14: Proportion correct
## 15: Proportion correct
## 16: Proportion correct
## 17:           Symptoms
## 18:           Symptoms
## 19:           Symptoms
## 20:           Symptoms
## 21:           Symptoms
## 22:           Symptoms
## 23:           Symptoms
## 24:           Symptoms
## 25:           Symptoms
## 26:           Symptoms
## 27:           Symptoms
## 28:           Symptoms
## 29:           Symptoms
## 30:           Symptoms
## 31:           Symptoms
## 32:           Symptoms
##               category
# ggsave("../paper/figs/pieces/fig8_modelpar_posteriors.png", all_ests_p , 
#        width=14, height=12, dpi=500)
# ggsave("../paper/figs/pieces/nowfig7_modelpar_posteriors.png", all_ests_p ,
#        width=14, height=12, dpi=500)

Robustness check in univariate models the results aligned w hypotheses

summary(phi_da_preds_bayes <- rstanarm::stan_glm(
  scale(depr_anx_norm_sum) ~
             
             scale(phi), 
             data=m35))
## 
## SAMPLING FOR MODEL 'continuous' NOW (CHAIN 1).
## Chain 1: 
## Chain 1: Gradient evaluation took 1.2e-05 seconds
## Chain 1: 1000 transitions using 10 leapfrog steps per transition would take 0.12 seconds.
## Chain 1: Adjust your expectations accordingly!
## Chain 1: 
## Chain 1: 
## Chain 1: Iteration:    1 / 2000 [  0%]  (Warmup)
## Chain 1: Iteration:  200 / 2000 [ 10%]  (Warmup)
## Chain 1: Iteration:  400 / 2000 [ 20%]  (Warmup)
## Chain 1: Iteration:  600 / 2000 [ 30%]  (Warmup)
## Chain 1: Iteration:  800 / 2000 [ 40%]  (Warmup)
## Chain 1: Iteration: 1000 / 2000 [ 50%]  (Warmup)
## Chain 1: Iteration: 1001 / 2000 [ 50%]  (Sampling)
## Chain 1: Iteration: 1200 / 2000 [ 60%]  (Sampling)
## Chain 1: Iteration: 1400 / 2000 [ 70%]  (Sampling)
## Chain 1: Iteration: 1600 / 2000 [ 80%]  (Sampling)
## Chain 1: Iteration: 1800 / 2000 [ 90%]  (Sampling)
## Chain 1: Iteration: 2000 / 2000 [100%]  (Sampling)
## Chain 1: 
## Chain 1:  Elapsed Time: 0.017 seconds (Warm-up)
## Chain 1:                0.034 seconds (Sampling)
## Chain 1:                0.051 seconds (Total)
## Chain 1: 
## 
## SAMPLING FOR MODEL 'continuous' NOW (CHAIN 2).
## Chain 2: 
## Chain 2: Gradient evaluation took 7e-06 seconds
## Chain 2: 1000 transitions using 10 leapfrog steps per transition would take 0.07 seconds.
## Chain 2: Adjust your expectations accordingly!
## Chain 2: 
## Chain 2: 
## Chain 2: Iteration:    1 / 2000 [  0%]  (Warmup)
## Chain 2: Iteration:  200 / 2000 [ 10%]  (Warmup)
## Chain 2: Iteration:  400 / 2000 [ 20%]  (Warmup)
## Chain 2: Iteration:  600 / 2000 [ 30%]  (Warmup)
## Chain 2: Iteration:  800 / 2000 [ 40%]  (Warmup)
## Chain 2: Iteration: 1000 / 2000 [ 50%]  (Warmup)
## Chain 2: Iteration: 1001 / 2000 [ 50%]  (Sampling)
## Chain 2: Iteration: 1200 / 2000 [ 60%]  (Sampling)
## Chain 2: Iteration: 1400 / 2000 [ 70%]  (Sampling)
## Chain 2: Iteration: 1600 / 2000 [ 80%]  (Sampling)
## Chain 2: Iteration: 1800 / 2000 [ 90%]  (Sampling)
## Chain 2: Iteration: 2000 / 2000 [100%]  (Sampling)
## Chain 2: 
## Chain 2:  Elapsed Time: 0.017 seconds (Warm-up)
## Chain 2:                0.032 seconds (Sampling)
## Chain 2:                0.049 seconds (Total)
## Chain 2: 
## 
## SAMPLING FOR MODEL 'continuous' NOW (CHAIN 3).
## Chain 3: 
## Chain 3: Gradient evaluation took 4e-06 seconds
## Chain 3: 1000 transitions using 10 leapfrog steps per transition would take 0.04 seconds.
## Chain 3: Adjust your expectations accordingly!
## Chain 3: 
## Chain 3: 
## Chain 3: Iteration:    1 / 2000 [  0%]  (Warmup)
## Chain 3: Iteration:  200 / 2000 [ 10%]  (Warmup)
## Chain 3: Iteration:  400 / 2000 [ 20%]  (Warmup)
## Chain 3: Iteration:  600 / 2000 [ 30%]  (Warmup)
## Chain 3: Iteration:  800 / 2000 [ 40%]  (Warmup)
## Chain 3: Iteration: 1000 / 2000 [ 50%]  (Warmup)
## Chain 3: Iteration: 1001 / 2000 [ 50%]  (Sampling)
## Chain 3: Iteration: 1200 / 2000 [ 60%]  (Sampling)
## Chain 3: Iteration: 1400 / 2000 [ 70%]  (Sampling)
## Chain 3: Iteration: 1600 / 2000 [ 80%]  (Sampling)
## Chain 3: Iteration: 1800 / 2000 [ 90%]  (Sampling)
## Chain 3: Iteration: 2000 / 2000 [100%]  (Sampling)
## Chain 3: 
## Chain 3:  Elapsed Time: 0.016 seconds (Warm-up)
## Chain 3:                0.032 seconds (Sampling)
## Chain 3:                0.048 seconds (Total)
## Chain 3: 
## 
## SAMPLING FOR MODEL 'continuous' NOW (CHAIN 4).
## Chain 4: 
## Chain 4: Gradient evaluation took 7e-06 seconds
## Chain 4: 1000 transitions using 10 leapfrog steps per transition would take 0.07 seconds.
## Chain 4: Adjust your expectations accordingly!
## Chain 4: 
## Chain 4: 
## Chain 4: Iteration:    1 / 2000 [  0%]  (Warmup)
## Chain 4: Iteration:  200 / 2000 [ 10%]  (Warmup)
## Chain 4: Iteration:  400 / 2000 [ 20%]  (Warmup)
## Chain 4: Iteration:  600 / 2000 [ 30%]  (Warmup)
## Chain 4: Iteration:  800 / 2000 [ 40%]  (Warmup)
## Chain 4: Iteration: 1000 / 2000 [ 50%]  (Warmup)
## Chain 4: Iteration: 1001 / 2000 [ 50%]  (Sampling)
## Chain 4: Iteration: 1200 / 2000 [ 60%]  (Sampling)
## Chain 4: Iteration: 1400 / 2000 [ 70%]  (Sampling)
## Chain 4: Iteration: 1600 / 2000 [ 80%]  (Sampling)
## Chain 4: Iteration: 1800 / 2000 [ 90%]  (Sampling)
## Chain 4: Iteration: 2000 / 2000 [100%]  (Sampling)
## Chain 4: 
## Chain 4:  Elapsed Time: 0.017 seconds (Warm-up)
## Chain 4:                0.033 seconds (Sampling)
## Chain 4:                0.05 seconds (Total)
## Chain 4:
## 
## Model Info:
##  function:     stan_glm
##  family:       gaussian [identity]
##  formula:      scale(depr_anx_norm_sum) ~ scale(phi)
##  algorithm:    sampling
##  sample:       4000 (posterior sample size)
##  priors:       see help('prior_summary')
##  observations: 275
##  predictors:   2
## 
## Estimates:
##               mean   sd   10%   50%   90%
## (Intercept)  0.0    0.1 -0.1   0.0   0.1 
## scale(phi)   0.0    0.1 -0.1   0.0   0.1 
## sigma        1.0    0.0  0.9   1.0   1.1 
## 
## Fit Diagnostics:
##            mean   sd   10%   50%   90%
## mean_PPD  0.0    0.1 -0.1   0.0   0.1 
## 
## The mean_ppd is the sample average posterior predictive distribution of the outcome variable (for details see help('summary.stanreg')).
## 
## MCMC diagnostics
##               mcse Rhat n_eff
## (Intercept)   0.0  1.0  3585 
## scale(phi)    0.0  1.0  4344 
## sigma         0.0  1.0  4020 
## mean_PPD      0.0  1.0  3912 
## log-posterior 0.0  1.0  2034 
## 
## For each parameter, mcse is Monte Carlo standard error, n_eff is a crude measure of effective sample size, and Rhat is the potential scale reduction factor on split chains (at convergence Rhat=1).
summary(kappa_da_preds_bayes <- rstanarm::stan_glm(
  scale(depr_anx_norm_sum) ~
             scale(kappa),
             data=m35))
## 
## SAMPLING FOR MODEL 'continuous' NOW (CHAIN 1).
## Chain 1: 
## Chain 1: Gradient evaluation took 8e-06 seconds
## Chain 1: 1000 transitions using 10 leapfrog steps per transition would take 0.08 seconds.
## Chain 1: Adjust your expectations accordingly!
## Chain 1: 
## Chain 1: 
## Chain 1: Iteration:    1 / 2000 [  0%]  (Warmup)
## Chain 1: Iteration:  200 / 2000 [ 10%]  (Warmup)
## Chain 1: Iteration:  400 / 2000 [ 20%]  (Warmup)
## Chain 1: Iteration:  600 / 2000 [ 30%]  (Warmup)
## Chain 1: Iteration:  800 / 2000 [ 40%]  (Warmup)
## Chain 1: Iteration: 1000 / 2000 [ 50%]  (Warmup)
## Chain 1: Iteration: 1001 / 2000 [ 50%]  (Sampling)
## Chain 1: Iteration: 1200 / 2000 [ 60%]  (Sampling)
## Chain 1: Iteration: 1400 / 2000 [ 70%]  (Sampling)
## Chain 1: Iteration: 1600 / 2000 [ 80%]  (Sampling)
## Chain 1: Iteration: 1800 / 2000 [ 90%]  (Sampling)
## Chain 1: Iteration: 2000 / 2000 [100%]  (Sampling)
## Chain 1: 
## Chain 1:  Elapsed Time: 0.016 seconds (Warm-up)
## Chain 1:                0.032 seconds (Sampling)
## Chain 1:                0.048 seconds (Total)
## Chain 1: 
## 
## SAMPLING FOR MODEL 'continuous' NOW (CHAIN 2).
## Chain 2: 
## Chain 2: Gradient evaluation took 3e-06 seconds
## Chain 2: 1000 transitions using 10 leapfrog steps per transition would take 0.03 seconds.
## Chain 2: Adjust your expectations accordingly!
## Chain 2: 
## Chain 2: 
## Chain 2: Iteration:    1 / 2000 [  0%]  (Warmup)
## Chain 2: Iteration:  200 / 2000 [ 10%]  (Warmup)
## Chain 2: Iteration:  400 / 2000 [ 20%]  (Warmup)
## Chain 2: Iteration:  600 / 2000 [ 30%]  (Warmup)
## Chain 2: Iteration:  800 / 2000 [ 40%]  (Warmup)
## Chain 2: Iteration: 1000 / 2000 [ 50%]  (Warmup)
## Chain 2: Iteration: 1001 / 2000 [ 50%]  (Sampling)
## Chain 2: Iteration: 1200 / 2000 [ 60%]  (Sampling)
## Chain 2: Iteration: 1400 / 2000 [ 70%]  (Sampling)
## Chain 2: Iteration: 1600 / 2000 [ 80%]  (Sampling)
## Chain 2: Iteration: 1800 / 2000 [ 90%]  (Sampling)
## Chain 2: Iteration: 2000 / 2000 [100%]  (Sampling)
## Chain 2: 
## Chain 2:  Elapsed Time: 0.017 seconds (Warm-up)
## Chain 2:                0.033 seconds (Sampling)
## Chain 2:                0.05 seconds (Total)
## Chain 2: 
## 
## SAMPLING FOR MODEL 'continuous' NOW (CHAIN 3).
## Chain 3: 
## Chain 3: Gradient evaluation took 7e-06 seconds
## Chain 3: 1000 transitions using 10 leapfrog steps per transition would take 0.07 seconds.
## Chain 3: Adjust your expectations accordingly!
## Chain 3: 
## Chain 3: 
## Chain 3: Iteration:    1 / 2000 [  0%]  (Warmup)
## Chain 3: Iteration:  200 / 2000 [ 10%]  (Warmup)
## Chain 3: Iteration:  400 / 2000 [ 20%]  (Warmup)
## Chain 3: Iteration:  600 / 2000 [ 30%]  (Warmup)
## Chain 3: Iteration:  800 / 2000 [ 40%]  (Warmup)
## Chain 3: Iteration: 1000 / 2000 [ 50%]  (Warmup)
## Chain 3: Iteration: 1001 / 2000 [ 50%]  (Sampling)
## Chain 3: Iteration: 1200 / 2000 [ 60%]  (Sampling)
## Chain 3: Iteration: 1400 / 2000 [ 70%]  (Sampling)
## Chain 3: Iteration: 1600 / 2000 [ 80%]  (Sampling)
## Chain 3: Iteration: 1800 / 2000 [ 90%]  (Sampling)
## Chain 3: Iteration: 2000 / 2000 [100%]  (Sampling)
## Chain 3: 
## Chain 3:  Elapsed Time: 0.016 seconds (Warm-up)
## Chain 3:                0.032 seconds (Sampling)
## Chain 3:                0.048 seconds (Total)
## Chain 3: 
## 
## SAMPLING FOR MODEL 'continuous' NOW (CHAIN 4).
## Chain 4: 
## Chain 4: Gradient evaluation took 4e-06 seconds
## Chain 4: 1000 transitions using 10 leapfrog steps per transition would take 0.04 seconds.
## Chain 4: Adjust your expectations accordingly!
## Chain 4: 
## Chain 4: 
## Chain 4: Iteration:    1 / 2000 [  0%]  (Warmup)
## Chain 4: Iteration:  200 / 2000 [ 10%]  (Warmup)
## Chain 4: Iteration:  400 / 2000 [ 20%]  (Warmup)
## Chain 4: Iteration:  600 / 2000 [ 30%]  (Warmup)
## Chain 4: Iteration:  800 / 2000 [ 40%]  (Warmup)
## Chain 4: Iteration: 1000 / 2000 [ 50%]  (Warmup)
## Chain 4: Iteration: 1001 / 2000 [ 50%]  (Sampling)
## Chain 4: Iteration: 1200 / 2000 [ 60%]  (Sampling)
## Chain 4: Iteration: 1400 / 2000 [ 70%]  (Sampling)
## Chain 4: Iteration: 1600 / 2000 [ 80%]  (Sampling)
## Chain 4: Iteration: 1800 / 2000 [ 90%]  (Sampling)
## Chain 4: Iteration: 2000 / 2000 [100%]  (Sampling)
## Chain 4: 
## Chain 4:  Elapsed Time: 0.017 seconds (Warm-up)
## Chain 4:                0.032 seconds (Sampling)
## Chain 4:                0.049 seconds (Total)
## Chain 4:
## 
## Model Info:
##  function:     stan_glm
##  family:       gaussian [identity]
##  formula:      scale(depr_anx_norm_sum) ~ scale(kappa)
##  algorithm:    sampling
##  sample:       4000 (posterior sample size)
##  priors:       see help('prior_summary')
##  observations: 275
##  predictors:   2
## 
## Estimates:
##                mean   sd   10%   50%   90%
## (Intercept)   0.0    0.1 -0.1   0.0   0.1 
## scale(kappa)  0.0    0.1 -0.1   0.0   0.0 
## sigma         1.0    0.0  0.9   1.0   1.1 
## 
## Fit Diagnostics:
##            mean   sd   10%   50%   90%
## mean_PPD  0.0    0.1 -0.1   0.0   0.1 
## 
## The mean_ppd is the sample average posterior predictive distribution of the outcome variable (for details see help('summary.stanreg')).
## 
## MCMC diagnostics
##               mcse Rhat n_eff
## (Intercept)   0.0  1.0  4043 
## scale(kappa)  0.0  1.0  3623 
## sigma         0.0  1.0  3636 
## mean_PPD      0.0  1.0  4066 
## log-posterior 0.0  1.0  2063 
## 
## For each parameter, mcse is Monte Carlo standard error, n_eff is a crude measure of effective sample size, and Rhat is the potential scale reduction factor on split chains (at convergence Rhat=1).
summary(npb_da_preds_bayes <- rstanarm::stan_glm(
  scale(depr_anx_norm_sum) ~
             
             scale(not_pun_bonus), 
             data=m35))
## 
## SAMPLING FOR MODEL 'continuous' NOW (CHAIN 1).
## Chain 1: 
## Chain 1: Gradient evaluation took 5e-06 seconds
## Chain 1: 1000 transitions using 10 leapfrog steps per transition would take 0.05 seconds.
## Chain 1: Adjust your expectations accordingly!
## Chain 1: 
## Chain 1: 
## Chain 1: Iteration:    1 / 2000 [  0%]  (Warmup)
## Chain 1: Iteration:  200 / 2000 [ 10%]  (Warmup)
## Chain 1: Iteration:  400 / 2000 [ 20%]  (Warmup)
## Chain 1: Iteration:  600 / 2000 [ 30%]  (Warmup)
## Chain 1: Iteration:  800 / 2000 [ 40%]  (Warmup)
## Chain 1: Iteration: 1000 / 2000 [ 50%]  (Warmup)
## Chain 1: Iteration: 1001 / 2000 [ 50%]  (Sampling)
## Chain 1: Iteration: 1200 / 2000 [ 60%]  (Sampling)
## Chain 1: Iteration: 1400 / 2000 [ 70%]  (Sampling)
## Chain 1: Iteration: 1600 / 2000 [ 80%]  (Sampling)
## Chain 1: Iteration: 1800 / 2000 [ 90%]  (Sampling)
## Chain 1: Iteration: 2000 / 2000 [100%]  (Sampling)
## Chain 1: 
## Chain 1:  Elapsed Time: 0.017 seconds (Warm-up)
## Chain 1:                0.033 seconds (Sampling)
## Chain 1:                0.05 seconds (Total)
## Chain 1: 
## 
## SAMPLING FOR MODEL 'continuous' NOW (CHAIN 2).
## Chain 2: 
## Chain 2: Gradient evaluation took 3e-06 seconds
## Chain 2: 1000 transitions using 10 leapfrog steps per transition would take 0.03 seconds.
## Chain 2: Adjust your expectations accordingly!
## Chain 2: 
## Chain 2: 
## Chain 2: Iteration:    1 / 2000 [  0%]  (Warmup)
## Chain 2: Iteration:  200 / 2000 [ 10%]  (Warmup)
## Chain 2: Iteration:  400 / 2000 [ 20%]  (Warmup)
## Chain 2: Iteration:  600 / 2000 [ 30%]  (Warmup)
## Chain 2: Iteration:  800 / 2000 [ 40%]  (Warmup)
## Chain 2: Iteration: 1000 / 2000 [ 50%]  (Warmup)
## Chain 2: Iteration: 1001 / 2000 [ 50%]  (Sampling)
## Chain 2: Iteration: 1200 / 2000 [ 60%]  (Sampling)
## Chain 2: Iteration: 1400 / 2000 [ 70%]  (Sampling)
## Chain 2: Iteration: 1600 / 2000 [ 80%]  (Sampling)
## Chain 2: Iteration: 1800 / 2000 [ 90%]  (Sampling)
## Chain 2: Iteration: 2000 / 2000 [100%]  (Sampling)
## Chain 2: 
## Chain 2:  Elapsed Time: 0.017 seconds (Warm-up)
## Chain 2:                0.033 seconds (Sampling)
## Chain 2:                0.05 seconds (Total)
## Chain 2: 
## 
## SAMPLING FOR MODEL 'continuous' NOW (CHAIN 3).
## Chain 3: 
## Chain 3: Gradient evaluation took 3e-06 seconds
## Chain 3: 1000 transitions using 10 leapfrog steps per transition would take 0.03 seconds.
## Chain 3: Adjust your expectations accordingly!
## Chain 3: 
## Chain 3: 
## Chain 3: Iteration:    1 / 2000 [  0%]  (Warmup)
## Chain 3: Iteration:  200 / 2000 [ 10%]  (Warmup)
## Chain 3: Iteration:  400 / 2000 [ 20%]  (Warmup)
## Chain 3: Iteration:  600 / 2000 [ 30%]  (Warmup)
## Chain 3: Iteration:  800 / 2000 [ 40%]  (Warmup)
## Chain 3: Iteration: 1000 / 2000 [ 50%]  (Warmup)
## Chain 3: Iteration: 1001 / 2000 [ 50%]  (Sampling)
## Chain 3: Iteration: 1200 / 2000 [ 60%]  (Sampling)
## Chain 3: Iteration: 1400 / 2000 [ 70%]  (Sampling)
## Chain 3: Iteration: 1600 / 2000 [ 80%]  (Sampling)
## Chain 3: Iteration: 1800 / 2000 [ 90%]  (Sampling)
## Chain 3: Iteration: 2000 / 2000 [100%]  (Sampling)
## Chain 3: 
## Chain 3:  Elapsed Time: 0.017 seconds (Warm-up)
## Chain 3:                0.033 seconds (Sampling)
## Chain 3:                0.05 seconds (Total)
## Chain 3: 
## 
## SAMPLING FOR MODEL 'continuous' NOW (CHAIN 4).
## Chain 4: 
## Chain 4: Gradient evaluation took 3e-06 seconds
## Chain 4: 1000 transitions using 10 leapfrog steps per transition would take 0.03 seconds.
## Chain 4: Adjust your expectations accordingly!
## Chain 4: 
## Chain 4: 
## Chain 4: Iteration:    1 / 2000 [  0%]  (Warmup)
## Chain 4: Iteration:  200 / 2000 [ 10%]  (Warmup)
## Chain 4: Iteration:  400 / 2000 [ 20%]  (Warmup)
## Chain 4: Iteration:  600 / 2000 [ 30%]  (Warmup)
## Chain 4: Iteration:  800 / 2000 [ 40%]  (Warmup)
## Chain 4: Iteration: 1000 / 2000 [ 50%]  (Warmup)
## Chain 4: Iteration: 1001 / 2000 [ 50%]  (Sampling)
## Chain 4: Iteration: 1200 / 2000 [ 60%]  (Sampling)
## Chain 4: Iteration: 1400 / 2000 [ 70%]  (Sampling)
## Chain 4: Iteration: 1600 / 2000 [ 80%]  (Sampling)
## Chain 4: Iteration: 1800 / 2000 [ 90%]  (Sampling)
## Chain 4: Iteration: 2000 / 2000 [100%]  (Sampling)
## Chain 4: 
## Chain 4:  Elapsed Time: 0.017 seconds (Warm-up)
## Chain 4:                0.034 seconds (Sampling)
## Chain 4:                0.051 seconds (Total)
## Chain 4:
## 
## Model Info:
##  function:     stan_glm
##  family:       gaussian [identity]
##  formula:      scale(depr_anx_norm_sum) ~ scale(not_pun_bonus)
##  algorithm:    sampling
##  sample:       4000 (posterior sample size)
##  priors:       see help('prior_summary')
##  observations: 275
##  predictors:   2
## 
## Estimates:
##                        mean   sd   10%   50%   90%
## (Intercept)           0.0    0.1 -0.1   0.0   0.1 
## scale(not_pun_bonus)  0.0    0.1  0.0   0.0   0.1 
## sigma                 1.0    0.0  1.0   1.0   1.1 
## 
## Fit Diagnostics:
##            mean   sd   10%   50%   90%
## mean_PPD  0.0    0.1 -0.1   0.0   0.1 
## 
## The mean_ppd is the sample average posterior predictive distribution of the outcome variable (for details see help('summary.stanreg')).
## 
## MCMC diagnostics
##                      mcse Rhat n_eff
## (Intercept)          0.0  1.0  3230 
## scale(not_pun_bonus) 0.0  1.0  3951 
## sigma                0.0  1.0  4100 
## mean_PPD             0.0  1.0  3879 
## log-posterior        0.0  1.0  1912 
## 
## For each parameter, mcse is Monte Carlo standard error, n_eff is a crude measure of effective sample size, and Rhat is the potential scale reduction factor on split chains (at convergence Rhat=1).

Sanity check against predictions of frequentist models and check their VIF

summary(da_preds <- lm(scale(depr_anx_norm_sum) ~
             scale(kappa) +
             scale(alpha_pos) +
             scale(alpha_neg) +
             scale(phi) +
             scale(rho) +
             scale(rl_off) +
             scale(epsilon) +
             scale(not_pun_bonus), 
             data=m35))
## 
## Call:
## lm(formula = scale(depr_anx_norm_sum) ~ scale(kappa) + scale(alpha_pos) + 
##     scale(alpha_neg) + scale(phi) + scale(rho) + scale(rl_off) + 
##     scale(epsilon) + scale(not_pun_bonus), data = m35)
## 
## Residuals:
##     Min      1Q  Median      3Q     Max 
## -1.2405 -0.8318 -0.3049  0.6374  3.0287 
## 
## Coefficients:
##                        Estimate Std. Error t value Pr(>|t|)
## (Intercept)          -1.869e-16  6.076e-02   0.000    1.000
## scale(kappa)         -7.452e-02  7.183e-02  -1.037    0.300
## scale(alpha_pos)      6.659e-02  7.008e-02   0.950    0.343
## scale(alpha_neg)      6.385e-03  6.305e-02   0.101    0.919
## scale(phi)           -5.057e-02  7.146e-02  -0.708    0.480
## scale(rho)           -5.668e-03  6.513e-02  -0.087    0.931
## scale(rl_off)         6.695e-03  6.615e-02   0.101    0.919
## scale(epsilon)        5.269e-02  6.309e-02   0.835    0.404
## scale(not_pun_bonus)  6.138e-02  6.292e-02   0.976    0.330
## 
## Residual standard error: 1.008 on 266 degrees of freedom
## Multiple R-squared:  0.0145, Adjusted R-squared:  -0.01513 
## F-statistic: 0.4894 on 8 and 266 DF,  p-value: 0.8634
summary(rrs_preds <- lm(scale(RRS_sum) ~
             scale(kappa) +
             scale(alpha_pos) +
             scale(alpha_neg) +
             scale(phi) +
             scale(rho) +
             scale(rl_off) +
             scale(epsilon) +
             scale(not_pun_bonus), 
             data=m35))
## 
## Call:
## lm(formula = scale(RRS_sum) ~ scale(kappa) + scale(alpha_pos) + 
##     scale(alpha_neg) + scale(phi) + scale(rho) + scale(rl_off) + 
##     scale(epsilon) + scale(not_pun_bonus), data = m35)
## 
## Residuals:
##      Min       1Q   Median       3Q      Max 
## -1.54304 -0.80805 -0.03143  0.61693  2.77658 
## 
## Coefficients:
##                        Estimate Std. Error t value Pr(>|t|)
## (Intercept)          -7.697e-17  6.099e-02   0.000    1.000
## scale(kappa)         -2.798e-03  7.211e-02  -0.039    0.969
## scale(alpha_pos)      1.444e-02  7.035e-02   0.205    0.838
## scale(alpha_neg)     -2.077e-03  6.330e-02  -0.033    0.974
## scale(phi)           -2.554e-02  7.173e-02  -0.356    0.722
## scale(rho)            3.520e-02  6.538e-02   0.538    0.591
## scale(rl_off)         4.736e-02  6.641e-02   0.713    0.476
## scale(epsilon)        3.551e-02  6.333e-02   0.561    0.575
## scale(not_pun_bonus) -3.289e-03  6.316e-02  -0.052    0.959
## 
## Residual standard error: 1.011 on 266 degrees of freedom
## Multiple R-squared:  0.006906,   Adjusted R-squared:  -0.02296 
## F-statistic: 0.2312 on 8 and 266 DF,  p-value: 0.9849
summary(learning_preds <- lm(scale(learn_m) ~
             scale(kappa) +
             scale(alpha_pos) +
             scale(alpha_neg) +
             scale(phi) +
             scale(rho) +
             scale(rl_off) +
             scale(epsilon) +
             scale(not_pun_bonus),  
             data=m35))
## 
## Call:
## lm(formula = scale(learn_m) ~ scale(kappa) + scale(alpha_pos) + 
##     scale(alpha_neg) + scale(phi) + scale(rho) + scale(rl_off) + 
##     scale(epsilon) + scale(not_pun_bonus), data = m35)
## 
## Residuals:
##      Min       1Q   Median       3Q      Max 
## -2.94486 -0.24830  0.04602  0.28117  1.60594 
## 
## Coefficients:
##                        Estimate Std. Error t value Pr(>|t|)    
## (Intercept)           2.684e-15  3.183e-02   0.000 1.000000    
## scale(kappa)          2.549e-01  3.764e-02   6.772 8.11e-11 ***
## scale(alpha_pos)      4.301e-01  3.672e-02  11.715  < 2e-16 ***
## scale(alpha_neg)      1.557e-01  3.304e-02   4.713 3.93e-06 ***
## scale(phi)           -2.687e-01  3.744e-02  -7.176 7.13e-12 ***
## scale(rho)            1.363e-01  3.412e-02   3.995 8.38e-05 ***
## scale(rl_off)        -2.667e-01  3.466e-02  -7.694 2.78e-13 ***
## scale(epsilon)       -3.080e-01  3.306e-02  -9.319  < 2e-16 ***
## scale(not_pun_bonus) -1.135e-01  3.297e-02  -3.444 0.000666 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 0.5279 on 266 degrees of freedom
## Multiple R-squared:  0.7295, Adjusted R-squared:  0.7213 
## F-statistic: 89.65 on 8 and 266 DF,  p-value: < 2.2e-16
summary(testing_preds <- lm(scale(test_m) ~
             scale(kappa) +
             scale(alpha_pos) +
             scale(alpha_neg) +
             scale(phi) +
             scale(rho) +
             scale(rl_off) +
             scale(epsilon) +
             scale(not_pun_bonus), 
             data=m35))
## 
## Call:
## lm(formula = scale(test_m) ~ scale(kappa) + scale(alpha_pos) + 
##     scale(alpha_neg) + scale(phi) + scale(rho) + scale(rl_off) + 
##     scale(epsilon) + scale(not_pun_bonus), data = m35)
## 
## Residuals:
##     Min      1Q  Median      3Q     Max 
## -4.0490 -0.2169  0.0521  0.3238  1.3265 
## 
## Coefficients:
##                        Estimate Std. Error t value Pr(>|t|)    
## (Intercept)           4.910e-15  3.284e-02   0.000   1.0000    
## scale(kappa)          5.739e-02  3.883e-02   1.478   0.1406    
## scale(alpha_pos)      6.386e-01  3.788e-02  16.858  < 2e-16 ***
## scale(alpha_neg)      1.718e-01  3.408e-02   5.040 8.63e-07 ***
## scale(phi)           -1.834e-01  3.862e-02  -4.747 3.37e-06 ***
## scale(rho)            7.813e-02  3.520e-02   2.219   0.0273 *  
## scale(rl_off)        -4.875e-01  3.576e-02 -13.633  < 2e-16 ***
## scale(epsilon)       -1.670e-01  3.410e-02  -4.896 1.70e-06 ***
## scale(not_pun_bonus) -3.211e-02  3.401e-02  -0.944   0.3460    
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 0.5446 on 266 degrees of freedom
## Multiple R-squared:  0.7121, Adjusted R-squared:  0.7034 
## F-statistic: 82.22 on 8 and 266 DF,  p-value: < 2.2e-16
car::vif(learning_preds)
##         scale(kappa)     scale(alpha_pos)     scale(alpha_neg) 
##             1.392691             1.325469             1.073142 
##           scale(phi)           scale(rho)        scale(rl_off) 
##             1.378196             1.144827             1.181171 
##       scale(epsilon) scale(not_pun_bonus) 
##             1.074371             1.068519
car::vif(testing_preds)
##         scale(kappa)     scale(alpha_pos)     scale(alpha_neg) 
##             1.392691             1.325469             1.073142 
##           scale(phi)           scale(rho)        scale(rl_off) 
##             1.378196             1.144827             1.181171 
##       scale(epsilon) scale(not_pun_bonus) 
##             1.074371             1.068519
car::vif(da_preds)
##         scale(kappa)     scale(alpha_pos)     scale(alpha_neg) 
##             1.392691             1.325469             1.073142 
##           scale(phi)           scale(rho)        scale(rl_off) 
##             1.378196             1.144827             1.181171 
##       scale(epsilon) scale(not_pun_bonus) 
##             1.074371             1.068519
car::vif(rrs_preds)
##         scale(kappa)     scale(alpha_pos)     scale(alpha_neg) 
##             1.392691             1.325469             1.073142 
##           scale(phi)           scale(rho)        scale(rl_off) 
##             1.378196             1.144827             1.181171 
##       scale(epsilon) scale(not_pun_bonus) 
##             1.074371             1.068519

Comparison to choice kernel rather than RL model

m41_v1 <- read.csv("../model_res/opt/best/BEST__RunHWMPRew34387.csv")
m41_v2 <- read.csv("../model_res/opt/best/BEST__RunHWMPRew47450.csv")
m41 <- rbind(m41_v1, m41_v2) %>% group_by(ID) %>% slice(which.min(nll))
#write.csv(m41, "../model_res/opt/best/BEST__m41_RunHWMPRew.csv")
hist(m41$learning_bias, breaks=100)

hist(m41$alpha_ck, breaks=100)

hist(m35$alpha_pos, breaks=100)

Highly correlated

ComparePars(m35$alpha_pos, m41$alpha_ck)

As expected not very correlated

ComparePars(m35$alpha_neg, m41$alpha_ck)

hist(m41$ck_off, breaks=100)

median(m41$ck_off)
## [1] 0.07782407
median(m35$rl_off)
## [1] 0.6136962
ComparePars(m35$rl_off, m41$ck_off)

Same number of pars so don’t need penalty to compare

ComparePars(m35$nll, m41$nll, "", "m35", "m41")

sum(m35$nll-m41$nll)
## [1] -500.0767
length(which(m35$nll < m41$nll))/length(m41$nll)
## [1] 0.6581818

0 rather than 1/3 inits

m42_v1 <- read.csv("../model_res/opt/best/BEST__RunHWMPRew0Inits18746.csv")
m42_v2 <- read.csv("../model_res/opt/best/BEST__RunHWMPRew0Inits77616.csv")
m42 <- rbind(m42_v1, m42_v2) %>% group_by(ID) %>% slice(which.min(nll))

Very similar but slightly worse than m41 and thus still substantially worse than m35

ComparePars(m35$nll, m42$nll, "", "m35", "m42")

sum(m35$nll-m42$nll)
## [1] -510.909
length(which(m35$nll < m42$nll))/length(m42$nll)
## [1] 0.6618182
m41_s <- read.csv("../model_res/sims/SIM_RunHWMPRew25874.csv")
m41_s_learn <- m41_s %>% filter(type=="learning")
m41_s_test <- m41_s %>% filter(type=="test")
pcor_ss_sim_m41 <- data.frame(m41_s_learn %>% group_by(set_size, stim_iter) %>%
                        summarize(m=mean(corrects), n()))
## `summarise()` has grouped output by 'set_size'. You can override using the
## `.groups` argument.
pcor_ss_sim_m41_iter <- data.frame(m41_s_learn %>% filter(iter %in% c(1:30)) %>%  group_by(stim_iter, set_size, iter) %>%
                        summarize(m=mean(corrects), n()))
## `summarise()` has grouped output by 'stim_iter', 'set_size'. You can override
## using the `.groups` argument.
sim_m41_p1 <- 
  ggplot(pcor_ss_sim_m41, aes(x=as.factor(stim_iter), y=m, group=as.factor(set_size), color=as.factor(set_size))) + 
  geom_line() + 
  geom_hline(yintercept=.33, size=1.5, color="gray57") + # chance line 
  geom_hline(yintercept=c(.5, .6, .7, .8, .9, 1), linetype="dotted") +
  geom_vline(xintercept=c(2, 5, 8, 10), linetype="dotted") +
  geom_jitter(data=pcor_ss_sim_m41_iter, aes(fill=as.factor(set_size)), color="black", height=0, width=.2, alpha=1,  size=2, pch=21) + 
  geom_point(aes(fill=as.factor(set_size)), color="black", size=6, pch=21, alpha=.7) + 
  annotate("rect", xmin=6, xmax=10.5, ymin=.3, ymax=1.1, alpha=0.2, fill="gray57") +
  ga + ap + lp + xlab("Stimulus iteration") + ylab("Proportion correct") + 
  tp + ggtitle("Simulated")
#ggsave("../paper/figs/pieces/supp6_sim_perf.png", sim_m41_p1, height = 3.5, width=6, dpi=300)
emp_sim_perf <- emp_p1 + sim_m41_p1 
emp_sim_perf

np_si_sims_summs <- m41_s %>% 
  filter(type=="learning" & corrects==0) %>% group_by(stim_iter) %>% #filter(stim_iter %in% c(2:10)) %>% 
  summarize(mw=mean(worsts), mn=mean(neutrals), n=n()) %>% mutate(neutral_pref=(mn-mw))

np_si_sims_summs_var <- m41_s %>% 
  filter(type=="learning" & corrects==0) %>%  group_by(stim_iter, iter) %>%  #filter(stim_iter %in% c(2:10)) %>% 
  summarize(mw=mean(worsts), mn=mean(neutrals), n=n()) %>% mutate(neutral_pref=(mn-mw))
## `summarise()` has grouped output by 'stim_iter'. You can override using the
## `.groups` argument.
m41_np_si_plot <- ggplot(np_si_sims_summs, 
                         aes(x=stim_iter, y=neutral_pref, fill=as.numeric(stim_iter))) +
       geom_hline(yintercept=.0, size=1.5, color="gray57") + # chance line 
  
  geom_bar(stat="identity", color="black") +
  geom_jitter(data=np_si_sims_summs_var, aes(x=stim_iter, y=neutral_pref), height=0,
              width=.2, pch=21) +
  annotate("rect", xmin=5.5, xmax=10.5, ymin=0, ymax=.22, alpha=0.2, pch=21) +
  annotate("text", x=3, y=.20, label="", size=8) +
  annotate("text", x=7.5, y=.20, label="", size=8) +
  ga + ap + tol + xlab("Simulus iteration") + ylab("") + tp + 
  ylim(-.05, .23) +
  ylab("Neutral preference \n during learning") +
  ggtitle("Simulated") + scale_color_gradient2() +
  scale_x_continuous(breaks=seq(1, 10, 1)) + ylim(-.1, .23)
## Warning in annotate("rect", xmin = 5.5, xmax = 10.5, ymin = 0, ymax = 0.22, :
## Ignoring unknown parameters: `shape`
## Scale for y is already present.
## Adding another scale for y, which will replace the existing scale.
m41_np_si_plot

#ggsave("../paper/figs/pieces/supp6_neut-pref_emp-and-sims.png", m41_np_si_plot, height = 4, width=11, dpi=300)

Test and SI6 data

pcor_p1_test_sim_m41 <- 
  data.frame(m41_s_test %>% filter(phase==1) %>% group_by(set_size) %>% summarize(m=mean(corrects)))

pcor_p1_test_sim_m41_iters <- 
  data.frame(m41_s_test %>% filter(phase==1) %>% group_by(set_size, iter) %>% summarize(m=mean(corrects)))
## `summarise()` has grouped output by 'set_size'. You can override using the
## `.groups` argument.
pcor_si6_sim_m41 <- 
  data.frame(m41_s_learn %>% filter(stim_iter==6) %>% group_by(set_size) %>% summarize(m=mean(corrects)))

pcor_si6_sim_m41_iters <- 
  data.frame(m41_s_learn %>% filter(stim_iter==6) %>% group_by(set_size, iter) %>% summarize(m=mean(corrects)))
## `summarise()` has grouped output by 'set_size'. You can override using the
## `.groups` argument.
pcor_p2_test_sim_m41 <- 
  data.frame(m41_s_test %>% filter(phase==2) %>% group_by(set_size) %>% summarize(m=mean(corrects)))

pcor_p2_test_sim_m41_iters <- 
  data.frame(m41_s_test %>% filter(phase==2) %>% group_by(set_size, iter) %>% summarize(m=mean(corrects)))
## `summarise()` has grouped output by 'set_size'. You can override using the
## `.groups` argument.
sim_p1_test_m41 <- 
ggplot(pcor_p1_test_sim_m41, aes(x=as.factor(set_size), y=m, fill=as.factor(set_size))) + 
  geom_hline(yintercept = seq(.1, 1, .1), alpha=.3) +
  geom_bar(stat="identity", color="black") +
  geom_jitter(data=pcor_p1_test_sim_m41_iters, size=2, alpha=1, width=.08, height=0, pch=21,
              aes(x=as.factor(set_size), y=m, fill=as.factor(set_size))) +
  ga + ap + xlab("Set size") + ylab("Proportion correct") + tol + ylim(0, 1) + 
  tp + ggtitle("Test phase 1")

sim_si6_m41 <- ggplot(pcor_si6_sim_m41, aes(x=as.factor(set_size), y=m, fill=as.factor(set_size))) + 
  geom_hline(yintercept = seq(.1, 1, .1), alpha=.3) +
  geom_bar(stat="identity", color="black") +
  geom_jitter(data=pcor_si6_sim_m41_iters, size=2, alpha=1, width=.08, height=0, pch=21,
              aes(x=as.factor(set_size), y=m, fill=as.factor(set_size))) +
  ga + ap + xlab("Set size") + ylab("") + tol + ylim(0, 1) + 
  tp + ggtitle("Stimulus iteration 6")

sim_p2_test_m41 <- ggplot(pcor_p2_test_sim_m41, aes(x=as.factor(set_size), y=m, fill=as.factor(set_size))) + 
  geom_hline(yintercept = seq(.1, 1, .1), alpha=.3) +
  geom_bar(stat="identity", color="black") +
  geom_jitter(data=pcor_p2_test_sim_m41_iters, size=2, alpha=1, width=.08, height=0, pch=21,
              aes(x=as.factor(set_size), y=m, fill=as.factor(set_size))) +
  ga + ap + xlab("Set size") + ylab("") + tol + ylim(0, 1) + tp +
  tp + ggtitle("Test phase 2")
sims_u_plot <- 
  sim_p1_test_m41 + sim_si6_m41 + sim_p2_test_m41 + plot_annotation(title="Simulated", theme = theme(plot.title = element_text(size = 25, hjust=.5)))#,
emps_u_plot

sims_u_plot

#ggsave("../paper/figs/pieces/supp6_simU.png", sims_u_plot, height = 4, width=11, dpi=300)
hist(m35$rl_off, breaks=50)

ck_off_p <- 
  ggplot(m41, aes(x=ck_off)) + 
  geom_vline(xintercept=median(m41$ck_off), size=4) +  
  geom_histogram(fill="white", color="black") + ga + ap + ylab("") + 
    ggtitle(TeX('$\\CK^{off}')) + tp + xlab("")
ck_off_p
## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.

median(m41$ck_off)
## [1] 0.07782407
median(m35$rl_off)
## [1] 0.6136962

Note: the learning bias par was implemented as a scalar on WM and RL such that lower values correspond to more shrinking of parameter, so plotting 1-bias so it has more intuitive interpretation as higher value = more insensitivity of WM and CK after negative PEs

lb_off_p <- 
  ggplot(m41, aes(x=1-learning_bias)) + 
  geom_vline(xintercept=median(1-m41$learning_bias), size=4) +  
  geom_histogram(fill="white", color="black") + ga + ap + ylab("") + 
    ggtitle(TeX('bias')) + tp + xlab("")
lb_off_p
## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.

Test neutral pref

m41_test_sim_error_df <- m41_s_test %>% filter(corrects==0)

np_test_summs_m41_sim_var <- m41_test_sim_error_df %>% group_by(phase, iter) %>% 
  summarize(mw=mean(worsts), mn=mean(neutrals), n=n()) %>% mutate(neutral_pref=(mn-mw))
## `summarise()` has grouped output by 'phase'. You can override using the
## `.groups` argument.
np_test_summs_m41_sim <- m41_test_sim_error_df %>% group_by(phase) %>% 
  summarize(mw=mean(worsts), mn=mean(neutrals), n=n()) %>% mutate(neutral_pref=(mn-mw))
sim_m41_np_si_test_plot <- 
  ggplot(np_test_summs_m41_sim , aes(x=as.factor(phase), y=neutral_pref, fill=as.factor(phase))) +
       geom_hline(yintercept=.0, size=1.5, color="gray57") + # chance line 
  geom_jitter(data=np_test_summs_m41_sim_var, height=0, width=.2, size=3, alpha=.8) + 
  geom_bar(stat="identity", color="black", alpha=.8) + 
  ga + ap + tol + xlab("Phase") + ylab("") + tp + 
  ylab("") +
  ggtitle("Neutral Preference at Test") + scale_fill_manual(values=c("gray81", "gray40")) + ylim(-.05, .23)
sim_m41_np_si_test_plot

#ggsave("../paper/figs/pieces/supp6_emp_np_si.png", sim_m41_np_si_test_plot, height = 4, width=5, dpi=300)

Revision 1 analyses - April 2025

Comp models

A model without CK-off (R2)

m45_v1 <- read.csv("../model_res/opt/r1/BEST__RunHWMPRewNoCKOff40569.csv")
m45_v2 <- read.csv("../model_res/opt/r1/BEST__RunHWMPRewNoCKOff55467.csv")
m45 <- rbind(m45_v1, m45_v2) %>% group_by(ID) %>% slice(which.min(nll))
m45$aic <- 2*7 + (2*m45$nll)
m35$aic <- 2*8 + (2*m35$nll)
m41$aic <- 2*8 + (2*m41$nll)

Better than m41 - as expected given that CK_off largely drops out

But m35 is better

sum(m45$aic-m41$aic)
## [1] -107.2754
sum(m45$aic-m35$aic)
## [1] 892.8779

A model without alpha-neg (R2)

m44_v1 <- read.csv("../model_res/opt/r1/BEST__RunRLWMPRewNoAlphaNeg39961.csv")
m44_v2 <- read.csv("../model_res/opt/r1/BEST__RunRLWMPRewNoAlphaNeg71023.csv")
m44 <- rbind(m44_v1, m44_v2) %>% group_by(ID) %>% slice(which.min(nll))
m44$aic <- 2*7 + (2*m44$nll)
sum(m44$aic-m35$aic)
## [1] -279.57

Beta as free par (R1)

m43_v1 <- read.csv("../model_res/opt/r1/BEST__RunRLWMPRewFreeBeta48142.csv")
m43_v2 <- read.csv("../model_res/opt/r1/BEST__RunRLWMPRewFreeBeta74624.csv")
m43 <- rbind(m43_v1, m43_v2) %>% group_by(ID) %>% slice(which.min(nll))
m43
## # A tibble: 275 × 13
## # Groups:   ID [275]
##        X kappa alpha_pos alpha_neg        phi   rho rl_off epsilon not_pun_bonus
##    <int> <dbl>     <dbl>     <dbl>      <dbl> <dbl>  <dbl>   <dbl>         <dbl>
##  1     1  4.86   0.00749  1.04e-11    1.63e-1 0.969 0.989  6.39e-2      0.276   
##  2     2  3.00   0.00430  3.50e- 5    1.06e-1 0.796 0.675  4.69e-2      0.294   
##  3     3  2.37   0.0216   7.33e- 3    9.18e-2 0.826 0.950  1.41e-2      0.000159
##  4     4  5.00   0.0126   8.46e- 3    3.05e-1 0.573 0.897  4.31e-3      0.301   
##  5     5  5.00   0.00993  7.88e- 3    4.45e-8 1.00  0.297  1.88e-2      0.318   
##  6     6  4.00   0.00989  7.64e- 4    6.47e-2 0.677 0.648  1.16e-2      0.0122  
##  7     7  2.01   0.00547  1.79e-11    6.50e-1 1.00  0.0759 5.05e-7      0.295   
##  8     8  4.00   0.00493  4.33e- 8    2.59e-1 0.751 0.525  8.55e-5      0.311   
##  9     9  2.00   0.0123   2.26e- 3    2.10e-1 0.829 0.344  1.10e-2      0.240   
## 10    10  2.35   0.00875  2.44e-10    4.94e-1 1.00  0.651  7.46e-3      0.265   
## # ℹ 265 more rows
## # ℹ 4 more variables: beta <dbl>, convergence <int>, nll <dbl>, ID <int>
m43$aic <- 2*9 + (2*m43$nll)
sum(m43$aic-m35$aic)
## [1] 537.8387
hist(m43$beta, breaks=100)

median(m43$beta)
## [1] 99.99372
range(m43$beta)
## [1]  48.53671 100.00000

Cooperative model (R1)

m46_v1 <- read.csv("../model_res/opt/r1/BEST__RunRLWMPRewRLCoop28307.csv")
m46_v2 <- read.csv("../model_res/opt/r1/BEST__RunRLWMPRewRLCoop43691.csv")
m46 <- rbind(m46_v1, m46_v2) %>% group_by(ID) %>% slice(which.min(nll))
m46$aic <- 2*8 + (2*m46$nll)
m46$aic
##   [1] 657.9113 673.6310 355.6322 422.4785 302.8202 411.7531 561.9239 533.7597
##   [9] 348.4627 546.0771 440.6410 519.6336 372.6330 682.7448 532.8232 421.8862
##  [17] 347.4877 584.1866 319.5221 797.3538 502.5073 332.5832 402.4423 310.6922
##  [25] 423.2779 558.3666 579.5965 552.7512 510.5496 286.7672 563.6752 381.6804
##  [33] 341.6969 322.5330 472.8042 437.2238 322.6155 693.1738 445.0903 394.5506
##  [41] 532.7560 306.8119 249.5198 228.2960 696.9983 439.6195 495.9143 440.6595
##  [49] 339.9792 438.0428 315.5709 335.7497 275.6222 503.1280 525.5943 292.6897
##  [57] 640.4472 264.1445 339.5003 343.9560 635.3746 481.8013 555.9784 377.8125
##  [65] 668.9959 700.5182 501.5803 654.9400 266.5762 604.3544 430.4483 623.0984
##  [73] 713.7603 375.5365 456.8394 592.1804 371.2550 357.3193 406.4699 451.5338
##  [81] 494.2514 585.0473 711.8325 454.7894 508.6997 585.4721 800.1018 373.9010
##  [89] 397.1721 407.7231 535.7058 537.6358 356.9338 461.3548 683.6732 344.7711
##  [97] 470.7618 460.4856 423.5232 620.3122 607.5765 518.6587 380.6512 372.6049
## [105] 376.5665 600.9686 715.3226 534.5477 317.2757 556.0924 656.8197 667.0566
## [113] 565.1796 630.0341 398.5066 527.1004 393.7972 358.7856 651.0503 291.0974
## [121] 710.7857 375.4100 456.7314 447.6592 394.3662 458.3966 550.1582 351.7796
## [129] 334.2987 447.6512 527.0600 258.3026 327.0925 692.6215 382.7200 519.2279
## [137] 498.5423 669.5945 511.8188 442.1568 564.8698 394.2968 556.6500 728.8326
## [145] 456.5204 374.7290 747.8617 431.8505 458.2467 745.0875 266.4778 329.5713
## [153] 530.3650 485.3927 712.1156 532.6562 469.7112 520.5911 462.6317 668.2532
## [161] 368.0290 542.1158 347.0277 349.2499 670.4564 401.2183 543.2899 457.9376
## [169] 459.5845 474.9527 466.9121 254.6618 479.4341 528.5166 368.1731 530.7842
## [177] 516.4059 564.5874 509.7509 520.9606 342.3941 394.1862 654.7533 362.3046
## [185] 432.3506 352.8767 366.5037 311.8529 749.9322 388.0716 349.5579 492.9030
## [193] 388.9756 552.4387 380.2611 362.2778 546.5077 627.3862 740.4460 290.6346
## [201] 478.5933 444.9668 470.8055 369.8958 228.3719 407.2859 359.7776 490.5454
## [209] 609.8815 460.3360 315.8436 414.2986 622.3109 697.7052 436.0732 345.2943
## [217] 422.8965 527.0873 421.0595 758.4641 468.7932 813.7139 445.7803 669.0853
## [225] 754.7364 629.7287 737.6912 540.3467 787.9368 441.4091 561.4427 375.6730
## [233] 540.8797 790.4927 677.5640 584.6093 656.7197 488.9378 626.9037 463.7150
## [241] 546.4709 608.3524 627.1683 369.5710 672.7593 490.0355 418.4378 424.6063
## [249] 312.4415 510.3994 819.1755 621.5651 467.4484 500.1032 549.2999 614.8079
## [257] 483.8098 578.0491 436.3867 419.5920 303.6017 519.4546 674.8202 622.3723
## [265] 501.8580 764.6776 502.7174 654.2016 458.4583 577.5701 695.4061 655.1905
## [273] 658.2343 470.0055 359.1658
sum(m46$nll-m35$nll)
## [1] 395.2627

Fits much worse so checking estimates are basically consistent

ComparePars(m46$kappa, m35$kappa)

ComparePars(m46$phi, m35$phi)

ComparePars(m46$alpha_pos, m35$alpha_pos, use_identity_line = 0)

ComparePars(m46$epsilon, m35$epsilon, use_identity_line = 0)

Reran rstanarm models for diagnostic stats (R3)

# summary(learn_preds_bayes <- rstanarm::stan_glm(
#   scale(learn_m) ~
#              scale(kappa) +
#              scale(alpha_pos) +
#              scale(alpha_neg) +
#              scale(phi) +
#              scale(rho) +
#              scale(rl_off) +
#              scale(epsilon) +
#              scale(not_pun_bonus), 
#              data=m35))
# 
# 
# summary(test_preds_bayes <- rstanarm::stan_glm(
#   scale(test_m) ~
#              scale(kappa) +
#              scale(alpha_pos) +
#              scale(alpha_neg) +
#              scale(phi) +
#              scale(rho) +
#              scale(rl_off) +
#              scale(epsilon) +
#              scale(not_pun_bonus), 
#              data=m35))
# 
# summary(da_preds_bayes <- rstanarm::stan_glm(
#   scale(depr_anx_norm_sum) ~
#              scale(kappa) +
#              scale(alpha_pos) +
#              scale(alpha_neg) +
#              scale(phi) +
#              scale(rho) +
#              scale(rl_off) +
#              scale(epsilon) +
#              scale(not_pun_bonus), 
#              data=m35))
# 
# summary(rrs_preds_bayes <- rstanarm::stan_glm(
#   scale(RRS_sum) ~
#              scale(kappa) +
#              scale(alpha_pos) +
#              scale(alpha_neg) +
#              scale(phi) +
#              scale(rho) +
#              scale(rl_off) +
#              scale(epsilon) +
#              scale(not_pun_bonus), 
#              data=m35))

Check if there’s evidence for a phase effect in test neutral-preference (R1)

phase_test <- read.csv("../model_res/brms_res/neutral_pref_test_effect__20330__.csv")
hist(phase_test$b_phase, breaks=100)

ReturnPosteriorMeanAnd90CI(phase_test$b_phase)
## 
## posterior mean = 0.04185185
## 90% CI =90% HDI: [-0.04, 0.12]

Visualizing subsets of pts for whom a given par wasn’t important (R2)

names(m35)
##  [1] "X.1"               "X"                 "kappa"            
##  [4] "alpha_pos"         "alpha_neg"         "phi"              
##  [7] "rho"               "rl_off"            "epsilon"          
## [10] "not_pun_bonus"     "convergence"       "nll"              
## [13] "ID"                "alpha_pos_greater" "depr_anx_norm_sum"
## [16] "BDI_sum"           "GAD_sum"           "RRS_sum"          
## [19] "learn_m"           "test_m"            "aic"

kappa, phi, rho, alpha-pos, alpha-neg, RL-off, non-pun-bonus, epsilon

PlotParHist <- function(model_df, param, tex_string) {
  ggplot(model_df, aes(x=param)) + 
  geom_vline(xintercept=median(param), size=4) +  
  geom_histogram(fill="white", color="black") + ga + ap + ylab("") + 
    ggtitle(TeX(tex_string)) + tp + xlab("") + 
    theme(axis.text = element_text(size=15))
}
p1 <- PlotParHist(m35, m35$kappa, '$\\kappa')
p2 <- PlotParHist(m35, m35$rho, '$\\rho')
p3 <- PlotParHist(m35, m35$phi, '$\\phi')
p4 <- PlotParHist(m35, m35$alpha_pos, '$\\alpha_{+}')
p5 <- PlotParHist(m35, m35$alpha_neg, '$\\alpha_{-}')
p6 <- PlotParHist(m35, m35$rl_off, '$\\RL^{off}')
p7 <- PlotParHist(m35, m35$not_pun_bonus, '$\\non-pun_{bonus}')
p8 <- PlotParHist(m35, m35$epsilon, '$\\epsilon')
wm_pars <- p1 + p2 + p3
rl_pars <- p4 + p5 + p6
other_pars <- p7 + p8 + p6
wm_pars
## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.
## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.
## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.

rl_pars
## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.
## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.
## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.

other_pars # RL off again just for balance in figure - cropped for paper fig 
## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.
## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.
## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.

ggsave("../paper/figs/pieces/par_distr_part1.png", wm_pars, height = 4.5, width=11, dpi=300)
## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.
## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.
## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.
ggsave("../paper/figs/pieces/par_distr_part2.png", rl_pars, height = 4.5, width=11, dpi=300)
## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.
## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.
## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.
ggsave("../paper/figs/pieces/par_distr_part3.png", other_pars, height = 4.5, width=11, dpi=300)
## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.
## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.
## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.

Total proportion of error trials (R2)

table(learn_df$correct)[1]/nrow(learn_df)
##         0 
## 0.2503758
table(test_df$correct)[1]/nrow(test_df)
##         0 
## 0.2299091

Test if the quadratic term is significant in simulations not just in

all_effs <- foreach (i = unique(m35_s$iter)) %do% {

  pcor_p1_si6_quad_sim <- NULL; pcor_p1_p1test_quad_sim <- NULL; effects_out <- NULL
  summary(pcor_p1_si6_quad_sim <- 
          glmer(corrects ~ poly(set_size, 2)  + 
                        (1|ID), 
                data=m35_s_learn %>% filter(stim_iter==6  & iter==i), 
                family="binomial", control = glmerControl(optimizer = "bobyqa")))
  
  summary(pcor_p1_p1test_quad_sim <- 
          glmer(corrects ~ poly(set_size, 2)  + 
                        (1|ID), 
                data=m35_s_test %>% filter(phase==1  & iter==i), 
                family="binomial", control = glmerControl(optimizer = "bobyqa")))
  
  effects_out <- data.frame("si6_est"=coef(summary(pcor_p1_si6_quad_sim))[3, 1], 
             "s6_p"=coef(summary(pcor_p1_si6_quad_sim))[3, 4],
             "p1test_est"=coef(summary(pcor_p1_p1test_quad_sim))[3, 1], 
             "p1test_p"=coef(summary(pcor_p1_p1test_quad_sim))[3, 4]
             )  

} %>% bind_rows()
si6_b0 <- all_effs %>% filter(!si6_est > 0)
nrow(si6_b0 %>% filter(!s6_p > .05))/nrow(all_effs)
## [1] 0.6
p1_b0 <- all_effs %>% filter(!p1test_est > 0)
nrow(p1_b0 %>% filter(!p1test_p > .05))/nrow(all_effs)
## [1] 0.96

Test if parameter ~ symptom relationships differ for depr or anxiety alone (R2)

summary(dep_preds_bayes <- rstanarm::stan_glm(
  scale(BDI_sum) ~
             scale(kappa) +
             scale(alpha_pos) +
             scale(alpha_neg) +
             scale(phi) +
             scale(rho) +
             scale(rl_off) +
             scale(epsilon) +
             scale(not_pun_bonus), 
             data=m35))
## 
## SAMPLING FOR MODEL 'continuous' NOW (CHAIN 1).
## Chain 1: 
## Chain 1: Gradient evaluation took 1.5e-05 seconds
## Chain 1: 1000 transitions using 10 leapfrog steps per transition would take 0.15 seconds.
## Chain 1: Adjust your expectations accordingly!
## Chain 1: 
## Chain 1: 
## Chain 1: Iteration:    1 / 2000 [  0%]  (Warmup)
## Chain 1: Iteration:  200 / 2000 [ 10%]  (Warmup)
## Chain 1: Iteration:  400 / 2000 [ 20%]  (Warmup)
## Chain 1: Iteration:  600 / 2000 [ 30%]  (Warmup)
## Chain 1: Iteration:  800 / 2000 [ 40%]  (Warmup)
## Chain 1: Iteration: 1000 / 2000 [ 50%]  (Warmup)
## Chain 1: Iteration: 1001 / 2000 [ 50%]  (Sampling)
## Chain 1: Iteration: 1200 / 2000 [ 60%]  (Sampling)
## Chain 1: Iteration: 1400 / 2000 [ 70%]  (Sampling)
## Chain 1: Iteration: 1600 / 2000 [ 80%]  (Sampling)
## Chain 1: Iteration: 1800 / 2000 [ 90%]  (Sampling)
## Chain 1: Iteration: 2000 / 2000 [100%]  (Sampling)
## Chain 1: 
## Chain 1:  Elapsed Time: 0.035 seconds (Warm-up)
## Chain 1:                0.049 seconds (Sampling)
## Chain 1:                0.084 seconds (Total)
## Chain 1: 
## 
## SAMPLING FOR MODEL 'continuous' NOW (CHAIN 2).
## Chain 2: 
## Chain 2: Gradient evaluation took 5e-06 seconds
## Chain 2: 1000 transitions using 10 leapfrog steps per transition would take 0.05 seconds.
## Chain 2: Adjust your expectations accordingly!
## Chain 2: 
## Chain 2: 
## Chain 2: Iteration:    1 / 2000 [  0%]  (Warmup)
## Chain 2: Iteration:  200 / 2000 [ 10%]  (Warmup)
## Chain 2: Iteration:  400 / 2000 [ 20%]  (Warmup)
## Chain 2: Iteration:  600 / 2000 [ 30%]  (Warmup)
## Chain 2: Iteration:  800 / 2000 [ 40%]  (Warmup)
## Chain 2: Iteration: 1000 / 2000 [ 50%]  (Warmup)
## Chain 2: Iteration: 1001 / 2000 [ 50%]  (Sampling)
## Chain 2: Iteration: 1200 / 2000 [ 60%]  (Sampling)
## Chain 2: Iteration: 1400 / 2000 [ 70%]  (Sampling)
## Chain 2: Iteration: 1600 / 2000 [ 80%]  (Sampling)
## Chain 2: Iteration: 1800 / 2000 [ 90%]  (Sampling)
## Chain 2: Iteration: 2000 / 2000 [100%]  (Sampling)
## Chain 2: 
## Chain 2:  Elapsed Time: 0.032 seconds (Warm-up)
## Chain 2:                0.052 seconds (Sampling)
## Chain 2:                0.084 seconds (Total)
## Chain 2: 
## 
## SAMPLING FOR MODEL 'continuous' NOW (CHAIN 3).
## Chain 3: 
## Chain 3: Gradient evaluation took 8e-06 seconds
## Chain 3: 1000 transitions using 10 leapfrog steps per transition would take 0.08 seconds.
## Chain 3: Adjust your expectations accordingly!
## Chain 3: 
## Chain 3: 
## Chain 3: Iteration:    1 / 2000 [  0%]  (Warmup)
## Chain 3: Iteration:  200 / 2000 [ 10%]  (Warmup)
## Chain 3: Iteration:  400 / 2000 [ 20%]  (Warmup)
## Chain 3: Iteration:  600 / 2000 [ 30%]  (Warmup)
## Chain 3: Iteration:  800 / 2000 [ 40%]  (Warmup)
## Chain 3: Iteration: 1000 / 2000 [ 50%]  (Warmup)
## Chain 3: Iteration: 1001 / 2000 [ 50%]  (Sampling)
## Chain 3: Iteration: 1200 / 2000 [ 60%]  (Sampling)
## Chain 3: Iteration: 1400 / 2000 [ 70%]  (Sampling)
## Chain 3: Iteration: 1600 / 2000 [ 80%]  (Sampling)
## Chain 3: Iteration: 1800 / 2000 [ 90%]  (Sampling)
## Chain 3: Iteration: 2000 / 2000 [100%]  (Sampling)
## Chain 3: 
## Chain 3:  Elapsed Time: 0.029 seconds (Warm-up)
## Chain 3:                0.046 seconds (Sampling)
## Chain 3:                0.075 seconds (Total)
## Chain 3: 
## 
## SAMPLING FOR MODEL 'continuous' NOW (CHAIN 4).
## Chain 4: 
## Chain 4: Gradient evaluation took 6e-06 seconds
## Chain 4: 1000 transitions using 10 leapfrog steps per transition would take 0.06 seconds.
## Chain 4: Adjust your expectations accordingly!
## Chain 4: 
## Chain 4: 
## Chain 4: Iteration:    1 / 2000 [  0%]  (Warmup)
## Chain 4: Iteration:  200 / 2000 [ 10%]  (Warmup)
## Chain 4: Iteration:  400 / 2000 [ 20%]  (Warmup)
## Chain 4: Iteration:  600 / 2000 [ 30%]  (Warmup)
## Chain 4: Iteration:  800 / 2000 [ 40%]  (Warmup)
## Chain 4: Iteration: 1000 / 2000 [ 50%]  (Warmup)
## Chain 4: Iteration: 1001 / 2000 [ 50%]  (Sampling)
## Chain 4: Iteration: 1200 / 2000 [ 60%]  (Sampling)
## Chain 4: Iteration: 1400 / 2000 [ 70%]  (Sampling)
## Chain 4: Iteration: 1600 / 2000 [ 80%]  (Sampling)
## Chain 4: Iteration: 1800 / 2000 [ 90%]  (Sampling)
## Chain 4: Iteration: 2000 / 2000 [100%]  (Sampling)
## Chain 4: 
## Chain 4:  Elapsed Time: 0.031 seconds (Warm-up)
## Chain 4:                0.048 seconds (Sampling)
## Chain 4:                0.079 seconds (Total)
## Chain 4:
## 
## Model Info:
##  function:     stan_glm
##  family:       gaussian [identity]
##  formula:      scale(BDI_sum) ~ scale(kappa) + scale(alpha_pos) + scale(alpha_neg) + 
##     scale(phi) + scale(rho) + scale(rl_off) + scale(epsilon) + 
##     scale(not_pun_bonus)
##  algorithm:    sampling
##  sample:       4000 (posterior sample size)
##  priors:       see help('prior_summary')
##  observations: 275
##  predictors:   9
## 
## Estimates:
##                        mean   sd   10%   50%   90%
## (Intercept)           0.0    0.1 -0.1   0.0   0.1 
## scale(kappa)         -0.1    0.1 -0.2  -0.1   0.0 
## scale(alpha_pos)      0.0    0.1  0.0   0.0   0.1 
## scale(alpha_neg)      0.0    0.1 -0.1   0.0   0.1 
## scale(phi)           -0.1    0.1 -0.2  -0.1   0.0 
## scale(rho)            0.0    0.1 -0.1   0.0   0.1 
## scale(rl_off)         0.0    0.1 -0.1   0.0   0.1 
## scale(epsilon)        0.0    0.1 -0.1   0.0   0.1 
## scale(not_pun_bonus)  0.1    0.1  0.0   0.1   0.2 
## sigma                 1.0    0.0  1.0   1.0   1.1 
## 
## Fit Diagnostics:
##            mean   sd   10%   50%   90%
## mean_PPD  0.0    0.1 -0.1   0.0   0.1 
## 
## The mean_ppd is the sample average posterior predictive distribution of the outcome variable (for details see help('summary.stanreg')).
## 
## MCMC diagnostics
##                      mcse Rhat n_eff
## (Intercept)          0.0  1.0  4532 
## scale(kappa)         0.0  1.0  3145 
## scale(alpha_pos)     0.0  1.0  3632 
## scale(alpha_neg)     0.0  1.0  4294 
## scale(phi)           0.0  1.0  3250 
## scale(rho)           0.0  1.0  3723 
## scale(rl_off)        0.0  1.0  4055 
## scale(epsilon)       0.0  1.0  4485 
## scale(not_pun_bonus) 0.0  1.0  4239 
## sigma                0.0  1.0  4151 
## mean_PPD             0.0  1.0  4117 
## log-posterior        0.1  1.0  1911 
## 
## For each parameter, mcse is Monte Carlo standard error, n_eff is a crude measure of effective sample size, and Rhat is the potential scale reduction factor on split chains (at convergence Rhat=1).
summary(anx_preds_bayes <- rstanarm::stan_glm(
  scale(GAD_sum) ~
             scale(kappa) +
             scale(alpha_pos) +
             scale(alpha_neg) +
             scale(phi) +
             scale(rho) +
             scale(rl_off) +
             scale(epsilon) +
             scale(not_pun_bonus), 
             data=m35))
## 
## SAMPLING FOR MODEL 'continuous' NOW (CHAIN 1).
## Chain 1: 
## Chain 1: Gradient evaluation took 1.4e-05 seconds
## Chain 1: 1000 transitions using 10 leapfrog steps per transition would take 0.14 seconds.
## Chain 1: Adjust your expectations accordingly!
## Chain 1: 
## Chain 1: 
## Chain 1: Iteration:    1 / 2000 [  0%]  (Warmup)
## Chain 1: Iteration:  200 / 2000 [ 10%]  (Warmup)
## Chain 1: Iteration:  400 / 2000 [ 20%]  (Warmup)
## Chain 1: Iteration:  600 / 2000 [ 30%]  (Warmup)
## Chain 1: Iteration:  800 / 2000 [ 40%]  (Warmup)
## Chain 1: Iteration: 1000 / 2000 [ 50%]  (Warmup)
## Chain 1: Iteration: 1001 / 2000 [ 50%]  (Sampling)
## Chain 1: Iteration: 1200 / 2000 [ 60%]  (Sampling)
## Chain 1: Iteration: 1400 / 2000 [ 70%]  (Sampling)
## Chain 1: Iteration: 1600 / 2000 [ 80%]  (Sampling)
## Chain 1: Iteration: 1800 / 2000 [ 90%]  (Sampling)
## Chain 1: Iteration: 2000 / 2000 [100%]  (Sampling)
## Chain 1: 
## Chain 1:  Elapsed Time: 0.03 seconds (Warm-up)
## Chain 1:                0.049 seconds (Sampling)
## Chain 1:                0.079 seconds (Total)
## Chain 1: 
## 
## SAMPLING FOR MODEL 'continuous' NOW (CHAIN 2).
## Chain 2: 
## Chain 2: Gradient evaluation took 7e-06 seconds
## Chain 2: 1000 transitions using 10 leapfrog steps per transition would take 0.07 seconds.
## Chain 2: Adjust your expectations accordingly!
## Chain 2: 
## Chain 2: 
## Chain 2: Iteration:    1 / 2000 [  0%]  (Warmup)
## Chain 2: Iteration:  200 / 2000 [ 10%]  (Warmup)
## Chain 2: Iteration:  400 / 2000 [ 20%]  (Warmup)
## Chain 2: Iteration:  600 / 2000 [ 30%]  (Warmup)
## Chain 2: Iteration:  800 / 2000 [ 40%]  (Warmup)
## Chain 2: Iteration: 1000 / 2000 [ 50%]  (Warmup)
## Chain 2: Iteration: 1001 / 2000 [ 50%]  (Sampling)
## Chain 2: Iteration: 1200 / 2000 [ 60%]  (Sampling)
## Chain 2: Iteration: 1400 / 2000 [ 70%]  (Sampling)
## Chain 2: Iteration: 1600 / 2000 [ 80%]  (Sampling)
## Chain 2: Iteration: 1800 / 2000 [ 90%]  (Sampling)
## Chain 2: Iteration: 2000 / 2000 [100%]  (Sampling)
## Chain 2: 
## Chain 2:  Elapsed Time: 0.033 seconds (Warm-up)
## Chain 2:                0.052 seconds (Sampling)
## Chain 2:                0.085 seconds (Total)
## Chain 2: 
## 
## SAMPLING FOR MODEL 'continuous' NOW (CHAIN 3).
## Chain 3: 
## Chain 3: Gradient evaluation took 7e-06 seconds
## Chain 3: 1000 transitions using 10 leapfrog steps per transition would take 0.07 seconds.
## Chain 3: Adjust your expectations accordingly!
## Chain 3: 
## Chain 3: 
## Chain 3: Iteration:    1 / 2000 [  0%]  (Warmup)
## Chain 3: Iteration:  200 / 2000 [ 10%]  (Warmup)
## Chain 3: Iteration:  400 / 2000 [ 20%]  (Warmup)
## Chain 3: Iteration:  600 / 2000 [ 30%]  (Warmup)
## Chain 3: Iteration:  800 / 2000 [ 40%]  (Warmup)
## Chain 3: Iteration: 1000 / 2000 [ 50%]  (Warmup)
## Chain 3: Iteration: 1001 / 2000 [ 50%]  (Sampling)
## Chain 3: Iteration: 1200 / 2000 [ 60%]  (Sampling)
## Chain 3: Iteration: 1400 / 2000 [ 70%]  (Sampling)
## Chain 3: Iteration: 1600 / 2000 [ 80%]  (Sampling)
## Chain 3: Iteration: 1800 / 2000 [ 90%]  (Sampling)
## Chain 3: Iteration: 2000 / 2000 [100%]  (Sampling)
## Chain 3: 
## Chain 3:  Elapsed Time: 0.032 seconds (Warm-up)
## Chain 3:                0.048 seconds (Sampling)
## Chain 3:                0.08 seconds (Total)
## Chain 3: 
## 
## SAMPLING FOR MODEL 'continuous' NOW (CHAIN 4).
## Chain 4: 
## Chain 4: Gradient evaluation took 6e-06 seconds
## Chain 4: 1000 transitions using 10 leapfrog steps per transition would take 0.06 seconds.
## Chain 4: Adjust your expectations accordingly!
## Chain 4: 
## Chain 4: 
## Chain 4: Iteration:    1 / 2000 [  0%]  (Warmup)
## Chain 4: Iteration:  200 / 2000 [ 10%]  (Warmup)
## Chain 4: Iteration:  400 / 2000 [ 20%]  (Warmup)
## Chain 4: Iteration:  600 / 2000 [ 30%]  (Warmup)
## Chain 4: Iteration:  800 / 2000 [ 40%]  (Warmup)
## Chain 4: Iteration: 1000 / 2000 [ 50%]  (Warmup)
## Chain 4: Iteration: 1001 / 2000 [ 50%]  (Sampling)
## Chain 4: Iteration: 1200 / 2000 [ 60%]  (Sampling)
## Chain 4: Iteration: 1400 / 2000 [ 70%]  (Sampling)
## Chain 4: Iteration: 1600 / 2000 [ 80%]  (Sampling)
## Chain 4: Iteration: 1800 / 2000 [ 90%]  (Sampling)
## Chain 4: Iteration: 2000 / 2000 [100%]  (Sampling)
## Chain 4: 
## Chain 4:  Elapsed Time: 0.032 seconds (Warm-up)
## Chain 4:                0.05 seconds (Sampling)
## Chain 4:                0.082 seconds (Total)
## Chain 4:
## 
## Model Info:
##  function:     stan_glm
##  family:       gaussian [identity]
##  formula:      scale(GAD_sum) ~ scale(kappa) + scale(alpha_pos) + scale(alpha_neg) + 
##     scale(phi) + scale(rho) + scale(rl_off) + scale(epsilon) + 
##     scale(not_pun_bonus)
##  algorithm:    sampling
##  sample:       4000 (posterior sample size)
##  priors:       see help('prior_summary')
##  observations: 275
##  predictors:   9
## 
## Estimates:
##                        mean   sd   10%   50%   90%
## (Intercept)           0.0    0.1 -0.1   0.0   0.1 
## scale(kappa)          0.0    0.1 -0.1   0.0   0.1 
## scale(alpha_pos)      0.1    0.1  0.0   0.1   0.2 
## scale(alpha_neg)      0.0    0.1 -0.1   0.0   0.1 
## scale(phi)            0.0    0.1 -0.1   0.0   0.1 
## scale(rho)            0.0    0.1 -0.1   0.0   0.1 
## scale(rl_off)         0.0    0.1 -0.1   0.0   0.1 
## scale(epsilon)        0.1    0.1  0.0   0.1   0.1 
## scale(not_pun_bonus)  0.0    0.1  0.0   0.0   0.1 
## sigma                 1.0    0.0  1.0   1.0   1.1 
## 
## Fit Diagnostics:
##            mean   sd   10%   50%   90%
## mean_PPD  0.0    0.1 -0.1   0.0   0.1 
## 
## The mean_ppd is the sample average posterior predictive distribution of the outcome variable (for details see help('summary.stanreg')).
## 
## MCMC diagnostics
##                      mcse Rhat n_eff
## (Intercept)          0.0  1.0  4708 
## scale(kappa)         0.0  1.0  2702 
## scale(alpha_pos)     0.0  1.0  3258 
## scale(alpha_neg)     0.0  1.0  4171 
## scale(phi)           0.0  1.0  2910 
## scale(rho)           0.0  1.0  3342 
## scale(rl_off)        0.0  1.0  3627 
## scale(epsilon)       0.0  1.0  3949 
## scale(not_pun_bonus) 0.0  1.0  3851 
## sigma                0.0  1.0  4063 
## mean_PPD             0.0  1.0  4425 
## log-posterior        0.1  1.0  1589 
## 
## For each parameter, mcse is Monte Carlo standard error, n_eff is a crude measure of effective sample size, and Rhat is the potential scale reduction factor on split chains (at convergence Rhat=1).

Get traces for each par

dep_traces <- data.frame(as.matrix(dep_preds_bayes))

dep_est <- ExtractEstimates(dep_traces)
dep_est$label <- "Depr/anx"
dep_est$category <- "Symptoms"
dep_est <- dep_est %>% filter(!coef %in% c("sigma", "X.Intercept."))
ReturnPosteriorMeanAnd90CI(dep_traces$scale.alpha_neg.)
## 
## posterior mean = 0.0006399384
## 90% CI =90% HDI: [-0.10, 0.10]
ReturnPosteriorMeanAnd90CI(dep_traces$scale.alpha_pos.) 
## 
## posterior mean = 0.04149709
## 90% CI =90% HDI: [-0.07, 0.16]
ReturnPosteriorMeanAnd90CI(dep_traces$scale.kappa.)
## 
## posterior mean = -0.1131731
## 90% CI =90% HDI: [-0.23, 0.01]
ReturnPosteriorMeanAnd90CI(dep_traces$scale.phi.)
## 
## posterior mean = -0.09880532
## 90% CI =90% HDI: [-0.22, 0.02]
ReturnPosteriorMeanAnd90CI(dep_traces$scale.rho.)
## 
## posterior mean = 0.02089014
## 90% CI =90% HDI: [-0.08, 0.13]
ReturnPosteriorMeanAnd90CI(dep_traces$scale.rl_off.)
## 
## posterior mean = -7.301957e-05
## 90% CI =90% HDI: [-0.11, 0.11]
ReturnPosteriorMeanAnd90CI(dep_traces$scale.epsilon.)
## 
## posterior mean = 0.02882101
## 90% CI =90% HDI: [-0.07, 0.13]
ReturnPosteriorMeanAnd90CI(dep_traces$scale.not_pun_bonus.)
## 
## posterior mean = 0.07356862
## 90% CI =90% HDI: [-0.04, 0.17]
ReturnPosteriorMeanAnd90CI(dep_traces$scale.kappa.)
## 
## posterior mean = -0.1131731
## 90% CI =90% HDI: [-0.23, 0.01]
ReturnPosteriorMeanAnd90CI(dep_traces$scale.phi.)
## 
## posterior mean = -0.09880532
## 90% CI =90% HDI: [-0.22, 0.02]
anx_traces <- data.frame(as.matrix(anx_preds_bayes))

anx_est <- ExtractEstimates(anx_traces)
anx_est$label <- "Depr/anx"
anx_est$category <- "Symptoms"
anx_est <- anx_est %>% filter(!coef %in% c("sigma", "X.Intercept."))
ReturnPosteriorMeanAnd90CI(anx_traces$scale.alpha_neg.)
## 
## posterior mean = 0.009752427
## 90% CI =90% HDI: [-0.09, 0.11]
ReturnPosteriorMeanAnd90CI(anx_traces$scale.alpha_pos.) 
## 
## posterior mean = 0.08514623
## 90% CI =90% HDI: [-0.03, 0.20]
ReturnPosteriorMeanAnd90CI(anx_traces$scale.kappa.)
## 
## posterior mean = -0.02639238
## 90% CI =90% HDI: [-0.14, 0.09]
ReturnPosteriorMeanAnd90CI(anx_traces$scale.phi.)
## 
## posterior mean = 0.003864791
## 90% CI =90% HDI: [-0.12, 0.12]
ReturnPosteriorMeanAnd90CI(anx_traces$scale.rho.)
## 
## posterior mean = -0.03227386
## 90% CI =90% HDI: [-0.14, 0.07]
ReturnPosteriorMeanAnd90CI(anx_traces$scale.rl_off.)
## 
## posterior mean = 0.01372818
## 90% CI =90% HDI: [-0.09, 0.12]
ReturnPosteriorMeanAnd90CI(anx_traces$scale.epsilon.)
## 
## posterior mean = 0.07020699
## 90% CI =90% HDI: [-0.03, 0.17]
ReturnPosteriorMeanAnd90CI(anx_traces$scale.not_pun_bonus.)
## 
## posterior mean = 0.04212543
## 90% CI =90% HDI: [-0.06, 0.14]
dep_anx_sep_ests <- rbind(
  data.frame("label"="Depression (BDI-II)", dep_est),
  data.frame("label"="Anxiety (GAD-7)", anx_est)
)
all_dep_anx_ests <- rbind(dep_est, anx_est)
all_dep_anx_ests$label <- factor(all_dep_anx_ests$label, levels=c("Depression", "Anxiety"))
all_dep_anx_ests
##                     coef       lb_10       ub_90             m label category
##  1:         scale.kappa. -0.23166674 0.008550829 -1.131731e-01  <NA> Symptoms
##  2:     scale.alpha_pos. -0.07423658 0.156325221  4.149709e-02  <NA> Symptoms
##  3:     scale.alpha_neg. -0.10404594 0.103361088  6.399384e-04  <NA> Symptoms
##  4:           scale.phi. -0.21690088 0.017054800 -9.880532e-02  <NA> Symptoms
##  5:           scale.rho. -0.08192580 0.129999615  2.089014e-02  <NA> Symptoms
##  6:        scale.rl_off. -0.10861203 0.109914129 -7.301957e-05  <NA> Symptoms
##  7:       scale.epsilon. -0.07055104 0.134630790  2.882101e-02  <NA> Symptoms
##  8: scale.not_pun_bonus. -0.03653798 0.172794391  7.356862e-02  <NA> Symptoms
##  9:         scale.kappa. -0.14497498 0.090739006 -2.639238e-02  <NA> Symptoms
## 10:     scale.alpha_pos. -0.02865711 0.201111006  8.514623e-02  <NA> Symptoms
## 11:     scale.alpha_neg. -0.09071951 0.112471877  9.752427e-03  <NA> Symptoms
## 12:           scale.phi. -0.11569068 0.116801826  3.864791e-03  <NA> Symptoms
## 13:           scale.rho. -0.14161725 0.072991570 -3.227386e-02  <NA> Symptoms
## 14:        scale.rl_off. -0.09387608 0.123853390  1.372818e-02  <NA> Symptoms
## 15:       scale.epsilon. -0.03025206 0.172386085  7.020699e-02  <NA> Symptoms
## 16: scale.not_pun_bonus. -0.06122417 0.143595657  4.212543e-02  <NA> Symptoms
all_dep_anx_ests_p <- 
  ggplot(dep_anx_sep_ests, #%>% filter(category=="Proportion correct"), 
       aes(y=coef, x=m, fill=label)) + 
  geom_vline(xintercept=0, size=1.3, color="gray35") +
  geom_vline(xintercept=c(-.5, -.25, .25, .5), color="gray65") +
  geom_errorbar(aes(xmin=lb_10, xmax=ub_90), width=.2, position=position_dodge(width=.4), size=1.5) +
  geom_point(pch=21, size=5, alpha=.9, position=position_dodge(width=.4)) + ga + ap + lp + 
  ylab("Regression coefficient \n of model parameter") + 
  xlab("Mean and 90% credible interval") +
  scale_y_discrete(labels=rev(c(
    TeX('$\\RL^{off}'),
    TeX('$\\rho'),
    TeX('$\\phi'),
    TeX('$\\n-p_{b}'),
    TeX('$\\kappa'),
    TeX('$\\epsilon'),
    TeX('$\\alpha_{+}'),
    TeX('$\\alpha_{-}')))) + ft +
  scale_fill_manual(values=c("orange1", "darkorange3")) +
  scale_x_continuous(labels=function(x) sprintf("%.1f", x)) + theme(axis.text.y = element_text(size=32)) #+ tol
# ggsave("../paper/figs/pieces/supp9_modelpar_posteriors.png", all_dep_anx_ests_p ,
#        width=14, height=12, dpi=500)

Descriptives for depression and anxiety scores (R3)

mean(qdf$BDI_sum); sd(qdf$BDI_sum); range(qdf$BDI_sum)
## [1] 14.21418
## [1] 13.95671
## [1]  0 58
mean(qdf$GAD_sum); sd(qdf$GAD_sum); range(qdf$GAD_sum)
## [1] 5.85697
## [1] 5.781763
## [1]  0 21

Add raw data points and means to symptom plots (R3)

bdi_means <- qdf %>% group_by(group) %>% summarize(m=mean(BDI_sum))
bdi_p_a <- ggplot(qdf, aes(x=BDI_sum, fill=group, color=group)) + 
  
  geom_density(alpha=.4, linewidth=3) + ga + ap + lp + ylab("") + 
  xlab("") + 
  theme(axis.text.y = element_blank()) + 
  theme(axis.ticks.y = element_blank()) + 
  scale_fill_manual(values=c("red", "blue", "gray")) +
  scale_color_manual(values=c("red", "blue", "gray")) + 
  ggtitle("Depression (BDI-II)") + tp + 
  tol

bdi_p_b <- ggplot(qdf, aes(x=BDI_sum, fill=group, color=group)) + 
  geom_histogram(alpha=.4, position="identity") +
  geom_vline(data=bdi_means, aes(xintercept = m, color=group), size=3) +
  ga + ap + lp + ylab("") + 
  xlab("") + 
  theme(axis.text.y = element_blank()) + 
  theme(axis.ticks.y = element_blank()) + 
  scale_fill_manual(values=c("red", "blue", "gray")) +
  scale_color_manual(values=c("red", "blue", "gray")) + 
  tol + facet_wrap(group ~ .) + ft + 
  theme(
  strip.background = element_blank(), 
  strip.text.x = element_blank(), 
  axis.text = element_text(size=14))
bdi_means
## # A tibble: 3 × 2
##   group          m
##   <chr>      <dbl>
## 1 anxiety     15.5
## 2 depression  16.4
## 3 unselected  12.2
bdi_p <- bdi_p_a/bdi_p_b
bdi_p
## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.

Just for legend

# ggplot(qdf, aes(x=BDI_sum, fill=group, color=group)) +
#   geom_density(alpha=.4, linewidth=3) + ga + ap + lp + ylab("") +
#   xlab("") +
#   theme(axis.text.y = element_blank()) +
#   theme(axis.ticks.y = element_blank()) +
#   scale_fill_manual(values=c("red", "blue", "gray")) +
#   scale_color_manual(values=c("red", "blue", "gray")) +
#   ggtitle("Depression (BDI-II)") + tp
gad_means <- qdf %>% group_by(group) %>% summarize(m=mean(GAD_sum))

# gad_p <- ggplot(qdf, aes(x=GAD_sum, fill=group, color=group)) + 
#   geom_vline(data=gad_means, aes(xintercept = m, color=group), size=3) +
#   geom_density(alpha=.4, linewidth=3) + ga + ap + lp + ylab("") + 
#   xlab("") + 
#   theme(axis.text.y = element_blank()) + 
#   theme(axis.ticks.y = element_blank()) + 
#   scale_fill_manual(values=c("red", "blue", "gray")) +
#   scale_color_manual(values=c("red", "blue", "gray")) + 
#   ggtitle("Generalized anxiety (GAD-7)") + tp + 
#   tol

gad_p_a <- ggplot(qdf, aes(x=GAD_sum, fill=group, color=group)) + 
  
  geom_density(alpha=.4, linewidth=3) + ga + ap + lp + ylab("") + 
  xlab("") + 
  theme(axis.text.y = element_blank()) + 
  theme(axis.ticks.y = element_blank()) + 
  scale_fill_manual(values=c("red", "blue", "gray")) +
  scale_color_manual(values=c("red", "blue", "gray")) + 
  ggtitle("Generalized anxiety (GAD-7)") + tp + 
  tol

gad_p_b <- ggplot(qdf, aes(x=GAD_sum, fill=group, color=group)) + 
  geom_vline(data=gad_means, aes(xintercept = m, color=group), size=3) +
  geom_histogram(alpha=.4, position="identity") +
  ga + ap + lp + ylab("") + 
  xlab("") + 
  theme(axis.text.y = element_blank()) + 
  theme(axis.ticks.y = element_blank()) + 
  scale_fill_manual(values=c("red", "blue", "gray")) +
  scale_color_manual(values=c("red", "blue", "gray")) + 
  tol + facet_wrap(group ~ .) + ft + 
  theme(
  strip.background = element_blank(), 
  strip.text.x = element_blank(), 
  axis.text = element_text(size=14))
gad_means
## # A tibble: 3 × 2
##   group          m
##   <chr>      <dbl>
## 1 anxiety     6.60
## 2 depression  7.15
## 3 unselected  4.67
gad_p <- gad_p_a/gad_p_b
gad_p
## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.

rrs_means <- qdf %>% group_by(group) %>% summarize(m=mean(RRS_sum))

# rrs_p <- ggplot(qdf, aes(x=RRS_sum, fill=group, color=group)) + 
#   geom_vline(data=rrs_means, aes(xintercept = m, color=group), size=3) +
#   geom_density(alpha=.4, linewidth=3) + ga + ap + lp + ylab("") + 
#   xlab("") + 
#   theme(axis.text.y = element_blank()) + 
#   theme(axis.ticks.y = element_blank()) + 
#   scale_fill_manual(values=c("red", "blue", "gray")) +
#   scale_color_manual(values=c("red", "blue", "gray")) + 
#   ggtitle("Rumination (RRS-SF)") + tp + 
#   tol

rrs_p_a <- ggplot(qdf, aes(x=RRS_sum, fill=group, color=group)) + 
  #geom_vline(data=rrs_means, aes(xintercept = m, color=group), size=3) +
  geom_density(alpha=.4, linewidth=3) + ga + ap + lp + ylab("") + 
  xlab("") + 
  theme(axis.text.y = element_blank()) + 
  theme(axis.ticks.y = element_blank()) + 
  scale_fill_manual(values=c("red", "blue", "gray")) +
  scale_color_manual(values=c("red", "blue", "gray")) + 
  ggtitle("Rumination (RRS-SF)") + tp + 
  tol

rrs_p_b <- ggplot(qdf, aes(x=RRS_sum, fill=group, color=group)) + 
  geom_vline(data=rrs_means, aes(xintercept = m, color=group), size=3) +
  geom_histogram(alpha=.4, position="identity") +
  ga + ap + lp + ylab("") + 
  xlab("") + 
  theme(axis.text.y = element_blank()) + 
  theme(axis.ticks.y = element_blank()) + 
  scale_fill_manual(values=c("red", "blue", "gray")) +
  scale_color_manual(values=c("red", "blue", "gray")) + 
  tol + facet_wrap(group ~ .) + ft + 
  theme(
  strip.background = element_blank(), 
  strip.text.x = element_blank(), 
  axis.text = element_text(size=14))
rrs_means
## # A tibble: 3 × 2
##   group          m
##   <chr>      <dbl>
## 1 anxiety     19.5
## 2 depression  21.9
## 3 unselected  19.7
rrs_p <- rrs_p_a/rrs_p_b
rrs_p
## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.

# sum(table(qdf$group))
# sym_plot <- bdi_p/ gad_p / rrs_p
# 
# sym_plot
ggsave("../paper/figs/supp-figs/sym-bdi.png", bdi_p, width=8.5, height = 4, dpi=200)
## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.
ggsave("../paper/figs/supp-figs/sym-gad.png", gad_p, width=8.5, height = 4, dpi=200)
## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.
ggsave("../paper/figs/supp-figs/sym-rrs.png", rrs_p, width=8.5, height = 4, dpi=200)
## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.